home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / libs / anivga12 / pcx2cod.pas < prev    next >
Pascal/Delphi Source File  |  1993-07-11  |  80KB  |  2,687 lines
  1. {$DEFINE StackCheck}
  2. {$DEFINE test}
  3.  
  4. {$IFDEF test}
  5.   {$A+,B-,D+,E-,F-,G-,I+,L+,N-,O-,R+,S+,V+,X-}
  6.   {$M 16384,0,655360}
  7. {$ELSE}
  8.   {$A+,B-,D+,E-,F-,G-,I-,L+,N-,O-,R-,S-,V-,X-}
  9.   {$M 16384,150000,655360}
  10. {$ENDIF}
  11.  
  12. PROGRAM PCX_to_COD_and_PIC_converter;
  13.  
  14. USES Dos,Graph,crt,Eingaben,Dateien;
  15. const
  16.       MausMinX=0;     {Koordinatenbereich für Maus}
  17.       MausMinY=0;
  18.       MausMaxX:INTEGER=0;
  19.       MausMaxY:INTEGER=0;
  20.       MausMaxX_mul2:INTEGER=0;
  21.       MausMaxY_mul2:INTEGER=0;
  22.  
  23.       SVGA320x200x256    = 0;    (* 320x200x256 Standard VGA *)
  24.       SVGA640x400x256    = 1;    (* 640x400x256 Svga *)
  25.       SVGA640x480x256    = 2;    (* 640x480x256 Svga *)
  26.       SVGA800x600x256    = 3;    (* 800x600x256 Svga *)
  27.       SVGA1024x768x256    = 4;    (* 1024x768x256 Svga *)
  28.  
  29. CONST EventNone=0;                 {gar nix}
  30.       EventError=1;                {Fehler }
  31.       EventQuit=2;                 {Programm vielleicht beenden}
  32.       EventHelp=9;                 {Hilfe}
  33.       EventMouseMoved=17;          {Maus wurde bewegt}
  34.       EventEndProgram=41;          {Programm tatsächlich beenden}
  35.       EventSpeichern=100;          {ausgewählten Grafikbereich abspeichern}
  36.  
  37. {---------Menu-Felder---------}
  38.  
  39. TYPE DrawBox=PROCEDURE;
  40.      box=RECORD  {Datentyp für ein Menufeld:}
  41.           x1,y1,                 {obere linke Boxecke}
  42.           x2,y2:WORD;            {untere rechte Ecke }
  43.           Name1,Name2:STRING[8]; {Beschriftung 1.+2.Zeile}
  44.           Show :DrawBox;         {Routine zum anzeigen des Icons}
  45.           Event:BYTE;            {zurückzugebender Wert}
  46.           Click:BOOLEAN;         {muß Maus geclickt werden für Event?}
  47.           Paint:BOOLEAN;         {Flag, ob Box zu zeichnen ist}
  48.          END;
  49.      boxes=ARRAY[1..3] OF box;  {alle Menufelder zusammen}
  50.  
  51.      ButtonStringTyp=STRING[8];  {Meldung in Clickboxen}
  52.  
  53. PROCEDURE Dummy; FAR; BEGIN END;
  54.  
  55. CONST Menu:boxes=(
  56.  
  57.  {gesamter Mausbereich kann auch als "Menubox" realisiert werden:}
  58.        (x1:MausMinX;    y1:MausMinY;
  59.         x2:0 {MausMaxX};    y2:0 {MausMaxY};
  60.         Name1:'';Name2:'';
  61.         Show :Dummy;
  62.         Event:EventMouseMoved;
  63.         Click:FALSE;    {kein Anclicken nötig}
  64.         Paint:FALSE),   {...wird aber nicht gezeichnet}
  65.  
  66.  {Sentinelwert, da x1>x2!}
  67.        (x1:1; y1:0; x2:0; y2:0;    
  68.         Name1:'';Name2:'';
  69.         Show :Dummy;
  70.         Event:EventNone;
  71.         Click:TRUE;
  72.         Paint:TRUE),
  73.  
  74.  {Noch einer als Füller, x1>x2!}
  75.        (x1:1; y1:0; x2:0; y2:0;    
  76.         Name1:'';Name2:'';
  77.         Show :Dummy;
  78.         Event:EventNone;
  79.         Click:TRUE;
  80.         Paint:TRUE)
  81.       );
  82.  
  83. VAR event:BYTE;
  84.     CRTAddress,      {Adresse des CRT-Ports, $3B4/$3D4 fuer monochrom/Farbe}
  85.     StatusReg:WORD;  {dto., fuer Statusregister, $3BA/$3DA}
  86.     Shift:BOOLEAN;   {gibt wieder, ob während Auswertung Shift gedrückt war}
  87.     BestWhite,       {Beste Näherungen der angeg. Farben}
  88.     BestBlack,
  89.     BestCyan,
  90.     BestLightGray,
  91.     BestDarkGray:BYTE;
  92.     MeldungX,MeldungY:INTEGER;
  93.  
  94. {-------------------- Ziffernausgabe ------------------}
  95. TYPE Ziffer=ARRAY[0..6,0..7] OF BYTE;
  96.      ToldArea=ARRAY[0..9*8,0..7] OF BYTE;
  97. CONST Ziffern:ARRAY['0'..'9'] OF Ziffer=
  98. (
  99. ((0,1,1,1,1,1,0,0),
  100.  (1,1,0,0,0,1,1,0),
  101.  (1,1,0,0,1,1,1,0),
  102.  (1,1,0,1,1,1,1,0),
  103.  (1,1,1,1,0,1,1,0),
  104.  (1,1,1,0,0,1,1,0),
  105.  (0,1,1,1,1,1,0,0)),
  106.  
  107. ((0,0,1,1,0,0,0,0),
  108.  (0,1,1,1,0,0,0,0),
  109.  (0,0,1,1,0,0,0,0),
  110.  (0,0,1,1,0,0,0,0),
  111.  (0,0,1,1,0,0,0,0),
  112.  (0,0,1,1,0,0,0,0),
  113.  (1,1,1,1,1,1,0,0)),
  114.  
  115. ((0,1,1,1,1,0,0,0),
  116.  (1,1,0,0,1,1,0,0),
  117.  (0,0,0,0,1,1,0,0),
  118.  (0,0,1,1,1,0,0,0),
  119.  (0,1,1,0,0,0,0,0),
  120.  (1,1,0,0,1,1,0,0),
  121.  (1,1,1,1,1,1,0,0)),
  122.  
  123. ((0,1,1,1,1,0,0,0),
  124.  (1,1,0,0,1,1,0,0),
  125.  (0,0,0,0,1,1,0,0),
  126.  (0,0,1,1,1,0,0,0),
  127.  (0,0,0,0,1,1,0,0),
  128.  (1,1,0,0,1,1,0,0),
  129.  (0,1,1,1,1,0,0,0)),
  130.  
  131. ((0,0,0,1,1,1,0,0),
  132.  (0,0,1,1,1,1,0,0),
  133.  (0,1,1,0,1,1,0,0),
  134.  (1,1,0,0,1,1,0,0),
  135.  (1,1,1,1,1,1,1,0),
  136.  (0,0,0,0,1,1,0,0),
  137.  (0,0,0,1,1,1,1,0)),
  138.  
  139. ((1,1,1,1,1,1,0,0),
  140.  (1,1,0,0,0,0,0,0),
  141.  (1,1,1,1,1,0,0,0),
  142.  (0,0,0,0,1,1,0,0),
  143.  (0,0,0,0,1,1,0,0),
  144.  (1,1,0,0,1,1,0,0),
  145.  (0,1,1,1,1,0,0,0)),
  146.  
  147. ((0,0,1,1,1,0,0,0),
  148.  (0,1,1,0,0,0,0,0),
  149.  (1,1,0,0,0,0,0,0),
  150.  (1,1,1,1,1,0,0,0),
  151.  (1,1,0,0,1,1,0,0),
  152.  (1,1,0,0,1,1,0,0),
  153.  (0,1,1,1,1,0,0,0)),
  154.  
  155. ((1,1,1,1,1,1,0,0),
  156.  (1,1,0,0,1,1,0,0),
  157.  (0,0,0,0,1,1,0,0),
  158.  (0,0,0,1,1,0,0,0),
  159.  (0,0,1,1,0,0,0,0),
  160.  (0,0,1,1,0,0,0,0),
  161.  (0,0,1,1,0,0,0,0)),
  162.  
  163. ((0,1,1,1,1,0,0,0),
  164.  (1,1,0,0,1,1,0,0),
  165.  (1,1,0,0,1,1,0,0),
  166.  (0,1,1,1,1,0,0,0),
  167.  (1,1,0,0,1,1,0,0),
  168.  (1,1,0,0,1,1,0,0),
  169.  (0,1,1,1,1,0,0,0)),
  170.  
  171. ((0,1,1,1,1,0,0,0),
  172.  (1,1,0,0,1,1,0,0),
  173.  (1,1,0,0,1,1,0,0),
  174.  (0,1,1,1,1,1,0,0),
  175.  (0,0,0,0,1,1,0,0),
  176.  (0,0,0,1,1,0,0,0),
  177.  (0,1,1,1,0,0,0,0))
  178. );
  179.  
  180. FUNCTION min(a,b:INTEGER):INTEGER;
  181. BEGIN
  182.  IF a<=b THEN min:=a ELSE min:=b
  183. END;
  184.  
  185. FUNCTION max(a,b:INTEGER):INTEGER;
  186. BEGIN
  187.  IF a>=b THEN max:=a ELSE max:=b
  188. END;
  189.  
  190. FUNCTION min3(a,b,c:INTEGER):INTEGER;
  191. BEGIN
  192.  min3:=min(a,min(b,c))
  193. END;
  194.  
  195. FUNCTION max3(a,b,c:INTEGER):INTEGER;
  196. BEGIN
  197.  max3:=max(a,max(b,c))
  198. END;
  199.  
  200. PROCEDURE PrintXY(x,y,a,b:INTEGER; VAR oldP:ToldArea);
  201. VAR n,i,j:INTEGER;
  202.     s:STRING[8];
  203. BEGIN
  204.  FOR i:=Max(0,x) TO Min(x+9*8-1,GetMaxX) DO
  205.   FOR j:=Max(0,y) TO Min(y+7,GetMaxY) DO
  206.    oldP[i-x,j-y]:=GetPixel(i,j);
  207.  
  208.  Str(a,s);
  209.  FOR n:=1 TO Length(s) DO
  210.   FOR j:=0 TO 6 DO
  211.    BEGIN
  212.     FOR i:=0 TO 7 DO
  213.      IF (Ziffern[s[n]][j,i]=1)
  214.        THEN PutPixel(x+i +Pred(n) SHL 3,y+j,BestWhite)
  215.    END;
  216.  
  217.  INC(x,Length(s) SHL 3 +4);
  218.  Str(b,s);
  219.  FOR n:=1 TO Length(s) DO
  220.   FOR j:=0 TO 6 DO
  221.    BEGIN
  222.     FOR i:=0 TO 7 DO
  223.      IF (Ziffern[s[n]][j,i]=1)
  224.        THEN PutPixel(x+i +Pred(n) SHL 3,y+j,BestWhite)
  225.    END;
  226. END;
  227.  
  228. {----------Maus-Routinen----------}
  229. CONST MouseMoved=1;
  230.       LeftButtonPressed=2;
  231.       LeftButtonReleased=4;
  232.       RightButtonPressed=8;
  233.       RightButtonReleased=16;
  234.       SuppressMouse:BOOLEAN=FALSE;
  235. VAR   Aufrufmaske,Maustasten:WORD;
  236.       MausX,MausY,MausXalt,MausYalt:INTEGER;
  237.       mouseX2,mouseY2:INTEGER; {interne Mauskoordinaten}
  238.       oldMouse:RECORD
  239.                 BoxLeft,BoxRight,BoxTop,BoxBottom :ARRAY[0..1023] OF BYTE;
  240.                 {Speicher für Windowbox}
  241.                 oldX,oldY:WORD;   {alte Mauskoordinaten}
  242.                 breite,hoehe:WORD;  {des Fensters}
  243.                 oldP:ToldArea;
  244.                END;
  245.       MouseUpdate:BOOLEAN;
  246.       LeftButton,RightButton:BOOLEAN;
  247.       regs:REGISTERS;
  248.  
  249.  
  250. FUNCTION MouseEvent(VAR menu):BYTE;
  251. { in: MausX,MausY = aktuelle Mausposition}
  252. {     LeftButton, RightButton = TRUE, wenn Mausbutton gedrückt}
  253. {     Shift = TRUE, falls Shifttaste während des Mausclicks gedrückt  }
  254. {             worden ist}
  255. {     menu = Array vom Typ "boxes", das die Menuboxkoordinaten enthält}
  256. {     EventNone = Rückgabewert, falls Maus in keinem der Felder steht }
  257. {out: Der Index desjenigen "menu"-Eintrages, in dem die Maus steht;   }
  258. {     sollte dies keiner sein, so wird "EventNone"=0 zurückgegeben    }
  259. {rem: Das Ende der Menueinträge muß durch einen Eintrag mit x1>x2 an- }
  260. {     gegeben werden!}
  261. VAR i:BYTE;
  262.     a:boxes ABSOLUTE menu;
  263. BEGIN
  264.  i:=1;
  265.  WHILE (a[i].x1<=a[i].x2) DO
  266.   BEGIN
  267.    WITH a[i] DO
  268.    IF (x1<=MausX) AND (MausX<=x2) AND (y1<=MausY) AND (MausY<=y2)
  269.       AND ( (NOT click) OR (LeftButton OR RightButton) )
  270.     THEN BEGIN
  271.           MouseEvent:=Event;
  272.           exit
  273.          END
  274.     ELSE INC(i)
  275.    END;
  276.  MouseEvent:=EventNone;
  277. END;
  278.  
  279. PROCEDURE DrawMaus;
  280. { in: MausX,MausY = Koordinaten für Mauscursor}
  281. {     MausXalt,MausYalt = Koord. des vorherigen Aufrufs}
  282. {     oldMouse.Box* = Platz für Grafikausschnitt unter Mauscursor}
  283. {out: oldMouse.* = gerettete Grafikdaten}
  284. {rem: Der Speicherplatz MouseMem^ muß bereits reserviert worden sein  }
  285. {     Obwohl die Routine "Cursor" nicht verändert, wird als VAR-Para- }
  286. {     meter übergeben, da dann nur ein Zeiger übergeben wird!}
  287. VAR i,oldX2,oldY2:WORD;
  288.     diff:INTEGER;
  289. BEGIN
  290.  WITH oldMouse DO
  291.   BEGIN
  292.    oldx:=MausX;  oldY:=MausY;
  293.    diff:=GetMaxX-(MausX+breite-1);
  294.    IF diff<0 THEN inc(breite,diff);
  295.    diff:=GetMaxY-(MausY+hoehe-1);
  296.    IF diff<0 THEN inc(hoehe,diff);
  297.    IF breite<1 THEN breite:=1;
  298.    IF hoehe<1 THEN hoehe:=1;
  299.    PrintXY(oldX+1,oldY+1,breite,hoehe,oldP);
  300.  
  301.    oldx2:=MausX+breite-1; oldY2:=MausY+hoehe-1;
  302.    FOR i:=oldX TO oldX2 DO
  303.     BEGIN
  304.      BoxTop[i]:=GetPixel(i,oldY);
  305.      BoxBottom[i]:=GetPixel(i,oldY2);
  306.      IF Odd(i)
  307.       THEN BEGIN
  308.             PutPixel(i,oldY,BestWhite);
  309.             PutPixel(i,oldY2,BestWhite)
  310.            END
  311.       ELSE BEGIN
  312.             PutPixel(i,oldY,BestBlack);
  313.             PutPixel(i,oldY2,BestBlack)
  314.            END
  315.     END;
  316.    FOR i:=oldY+1 TO oldY2-1 DO
  317.     BEGIN
  318.      BoxLeft[i]:=GetPixel(oldX,i);
  319.      BoxRight[i]:=GetPixel(oldX2,i);
  320.      IF Odd(i)
  321.       THEN BEGIN
  322.             PutPixel(oldX,i,BestWhite);
  323.             PutPixel(oldX2,i,BestWhite)
  324.            END
  325.       ELSE BEGIN
  326.             PutPixel(oldX,i,BestBlack);
  327.             PutPixel(oldX2,i,BestBlack)
  328.            END
  329.     END;
  330.  
  331.   END;
  332. END;
  333.  
  334. PROCEDURE UnDrawMaus;
  335. { in: oldMouse.* = zu restaurierende Grafikdaten}
  336. VAR i,j,oldX2,oldY2:WORD;
  337. BEGIN
  338.  WITH oldMouse DO
  339.   BEGIN
  340.    oldX2:=oldX+breite-1; oldY2:=oldY+hoehe-1;
  341.    FOR i:=oldX TO oldX2 DO
  342.     BEGIN
  343.      PutPixel(i,oldY,BoxTop[i]);
  344.      PutPixel(i,oldY2,BoxBottom[i])
  345.     END;
  346.    FOR i:=oldY+1 TO oldY2-1 DO
  347.     BEGIN
  348.      PutPixel(oldX,i,BoxLeft[i]);
  349.      PutPixel(oldX2,i,BoxRight[i])
  350.     END;
  351.    FOR i:=Max(0,oldX+1) TO Min(oldX+1+9*8-1,GetMaxX) DO
  352.     FOR j:=Max(0,oldY+1) TO Min(oldY+1+7,GetMaxY) DO
  353.      PutPixel(i,j,oldP[i-(oldX+1),j-(oldY+1)]);
  354.   END;
  355. END;
  356.  
  357. FUNCTION MouseInstalled : Boolean;
  358. { in: - }
  359. {out: TRUE|FALSE für: Maus gefunden/nicht gefunden}
  360. VAR INT33h:POINTER;
  361. BEGIN
  362.  GetIntVec($33,INT33h);
  363.  IF (BYTE(INT33h^)=$CF) OR (LONGINT(INT33h)=0)
  364.   THEN MouseInstalled:=FALSE  {nur IRET oder Nullpointer}
  365.   ELSE BEGIN {INT33h führt nicht ins Nirwana, trau dich!}
  366.         WRITELN(10);
  367.      (* regs.ax := 0;   {Ja hallo, gibt's hier ne Maus im System?}
  368.         Intr($33,regs);
  369.         MouseInstalled:=(regs.ax=$FFFF); *)
  370.         ASM
  371.           PUSHF
  372.           CLI
  373.           PUSH BX
  374.           PUSH CX
  375.           PUSH DX
  376.           PUSH SI
  377.           PUSH DI
  378.           PUSH BP
  379.           PUSH ES
  380.           PUSH DS
  381.  
  382.           mov ax,0
  383.           int 33h
  384.  
  385.           POP DS
  386.           POP ES
  387.           POP BP
  388.           POP DI
  389.           POP SI
  390.           POP DX
  391.           POP CX
  392.           POP BX
  393.           STI
  394.           POPF
  395.  
  396.           CMP AX,$FFFF
  397.           JNE @noMouse
  398.           MOV @Result,TRUE
  399.           JMP @done
  400.          @noMouse:
  401.           MOV @Result,FALSE
  402.          @done:
  403.         END;
  404.         WRITELN(9);
  405.        END;
  406. END;
  407.  
  408. PROCEDURE DisableMouse;
  409. inline($B0/<BYTE(TRUE)/     {MOV AL,TRUE}
  410.        $A2/SuppressMouse);  {MOV SuppressMouse,AL}
  411.  
  412. PROCEDURE EnableMouse;
  413. inline($B0/<BYTE(FALSE)/    {MOV AL,FALSE}
  414.        $A2/SuppressMouse);  {MOV SuppressMouse,AL}
  415.  
  416. PROCEDURE ClearMouse;
  417. BEGIN
  418.  MouseUpdate:=FALSE; LeftButton:=FALSE; RightButton:=FALSE;
  419.  EnableMouse;
  420. END;
  421.  
  422. {$S-}
  423. PROCEDURE MouseCallBack; FAR; ASSEMBLER;
  424. { in: mouseX2,mouseY2 = alte Mauskoordinaten}
  425. {     SuppressMouse = TRUE falls Mausereignis ignoriert werden soll}
  426. {     MausMinX,MausMinY = minimal zulässige Mauskoordinaten}
  427. {     MausMaxX,MausMaxY = maximal zulässige Mauskoordinaten}
  428. {out: Falls SuppressMouse=FALSE war, wurden folgende Variablen neugesetzt:}
  429. {     MouseUpdate = TRUE}
  430. {     MPressed = TRUE, falls linker Button gedrückt}
  431. {     Shift = TRUE, falls eine der Shifttasten gedrückt wurde}
  432. {     MausX,MausY = aktuelle Mauskoordinaten}
  433. {     SuppressMouse = TRUE}
  434. {rem: Diese Prozedur entspricht einer Interrupt-Service-Routine, die}
  435. {     immer dann aufgerufen wird, wenn eine der bei ihrer Initialisierung}
  436. {     angegebenen Aufrufbedingungen erfüllt ist}
  437. {     MouseUpdate = TRUE impliziert SuppressMouse:=TRUE, d.h.: die weitere}
  438. {     Aktualisierung von Mausdaten ist solange gesperrt, bis die alten   }
  439. {     verarbeitet wurden und die Maus mit "EnableMouse()" wieder freige- }
  440. {     geben wird!}
  441. ASM
  442.   pushf
  443.   push ax
  444.   push bx
  445.   push cx
  446.   push dx
  447.   push si
  448.   push di
  449.   push bp
  450.   push ds
  451.   push es
  452.   mov bp,SEG @DATA
  453.   mov DS,bp
  454.  
  455.   CMP SuppressMouse,TRUE {soll Maus überhaupt behandelt werden?}
  456.   JE @quit
  457.  
  458.   MOV AufrufMaske,AX
  459.   MOV MausTasten,BX
  460.   MOV SI,MausX
  461.   MOV MausXalt,SI
  462.   MOV MausX,CX
  463.   MOV SI,MausY
  464.   MOV MausYalt,SI
  465.   MOV MausY,DX
  466.  
  467.   MOV MouseUpdate,TRUE
  468.   MOV DX,AX
  469.   AND AX,LeftButtonPressed
  470.   JE @noLeftButton
  471.   MOV LeftButton,TRUE
  472.  @noLeftButton:
  473.   AND DX,RightButtonPressed
  474.   JE @noRightButton
  475.   MOV RightButton,TRUE
  476.  @noRightButton:
  477.  
  478.   XOR AX,AX       {Shift-Status der Tastatur auslesen:}
  479.   MOV ES,AX       {steht in mem[$40:$17] in den untersten 2 Bits}
  480.   MOV SI,417h
  481.   MOV AL,ES:[SI]
  482.   AND AL,3
  483.   JE @noShift
  484.   MOV Shift,TRUE
  485.   JMP @L1
  486.  @noShift:
  487.   MOV Shift,FALSE
  488.  
  489.  @L1:
  490.   MOV AX,11
  491.   INT 33h         {Koordinatenänderung einlesen}
  492.   MOV AX,mouseX2  {und Mauskoordinaten aktualisieren}
  493.   ADD AX,CX
  494.   CMP AX,MausMinX*2  {mouseX2:=max(MausMinX*2,mouseX2)}
  495.   JGE @noSmall1
  496.   MOV AX,MausMinX*2
  497.  @noSmall1:
  498.   CMP AX,MausMaxX_mul2  {mouseX2:=min(MausMaxX*2,mouseX2)}
  499.   JLE @noBig1
  500.   MOV AX,MausMaxX_mul2
  501.  @noBig1:
  502.   MOV mouseX2,AX
  503.   SHR AX,1        {dem doofen Treiber doch noch eine Auflösung}
  504.   MOV MausX,AX    {von 640x400 Punkten abringen}
  505.  
  506.   MOV AX,mouseY2
  507.   ADD AX,DX
  508.   CMP AX,MausMinY*2  {mouseY2:=max(MausMinY*2,mouseY2)}
  509.   JGE @noSmall2
  510.   MOV AX,MausMinY*2
  511.  @noSmall2:
  512.   CMP AX,MausMaxY_mul2  {mouseY2:=min(MausMaxY*2,mouseY2)}
  513.   JLE @noBig2
  514.   MOV AX,MausMaxY_mul2
  515.  @noBig2:
  516.   MOV mouseY2,AX
  517.   SHR AX,1
  518.   MOV MausY,AX
  519.  
  520.   MOV SuppressMouse,TRUE
  521.  
  522.  @quit:
  523.   pop es
  524.   pop ds
  525.   pop bp
  526.   pop di
  527.   pop si
  528.   pop dx
  529.   pop cx
  530.   pop bx
  531.   pop ax
  532.   popf
  533. END;
  534. {$IFDEF StackCheck} {$S+} {$ENDIF}
  535.  
  536. PROCEDURE PushAll;
  537. INLINE(
  538.   $9C/   { PUSHF     }
  539.   $50/   { PUSH   AX }
  540.   $53/   { PUSH   BX }
  541.   $51/   { PUSH   CX }
  542.   $52/   { PUSH   DX }
  543.   $56/   { PUSH   SI }
  544.   $57/   { PUSH   DI }
  545.   $55/   { PUSH   BP }
  546.   $06/   { PUSH   ES }
  547.   $1E);  { PUSH   DS }
  548.  
  549. PROCEDURE PopAll;
  550. INLINE(
  551.   $1F/   { POP    DS }
  552.   $07/   { POP    ES }
  553.   $5D/   { POP    BP }
  554.   $5F/   { POP    DI }
  555.   $5E/   { POP    SI }
  556.   $5A/   { POP    DX }
  557.   $59/   { POP    CX }
  558.   $5B/   { POP    BX }
  559.   $58/   { POP    AX }
  560.   $9D);  { POPF      }
  561.  
  562. FUNCTION LeftButtonStillPressed:BOOLEAN; ASSEMBLER;
  563. { in: - }
  564. {out: TRUE, falls linker Button noch immer gedrückt}
  565. ASM
  566.   PUSHF
  567.   PUSH BP
  568.   PUSH DS
  569.   MOV DI,OFFSET(@RestoreSS)
  570.   MOV CS:[DI+1],SS
  571.   MOV DI,OFFSET(@RestoreSP)
  572.   MOV CS:[DI+1],SP
  573.  
  574.   mov ax,5
  575.   mov bx,0
  576.   int 33h
  577.   and ax,1
  578.  
  579.   @RestoreSS:
  580.   MOV SP,1234h
  581.   MOV SS,SP
  582.   @RestoreSP:
  583.   MOV SP,1234h
  584.  
  585.   POP DS
  586.   POP BP
  587.   POPF
  588. END;
  589.  
  590. PROCEDURE UpdateBox;
  591. { in: MausX,MausY = Koordinaten für Mauscursor}
  592. {     MausXalt,MausYalt = Koord. des vorherigen Aufrufs}
  593. {rem: hierher, wenn Maus bewegt oder ein Button gedrückt wurde}
  594. BEGIN
  595.  IF LeftButton OR LeftButtonStillPressed
  596.   THEN BEGIN
  597.         Sound(100); Delay(10); NoSound;
  598.         WITH oldmouse DO
  599.          BEGIN
  600.           INC(breite,(MausXalt-MausX));
  601.           INC(hoehe,(MausYalt-MausY));
  602.           IF breite<1 THEN breite:=1;
  603.           IF hoehe<1 THEN hoehe:=1
  604.          END
  605.        END;
  606.  IF RightButton
  607.   THEN BEGIN
  608.         Sound(1000); Delay(10); NoSound;
  609.        END;
  610. END;
  611.  
  612. PROCEDURE initmouse;
  613. { in: MausMaxX,MausMaxY = max. zulässige Mausbildschirmkoordinaten}
  614. {     MausCallBack = Maus-Event-Handler (FAR-Prozedur!) }
  615. {out: mouseX|Y2=MausMinX|Y*2, MausX|Y=MausMinX|Y}
  616. {     Koordinatenbereich für Maus wurde entsprechend initialisert }
  617. {     MausCallBack wird bei jeder Mausbewegung/Buttonbetätigung gerufen}
  618. {     Maus ist "abgeschaltet" und muß erst mit "EnableMouse" aktiviert }
  619. {     werden}
  620. {rem: Vorhandensein einer Maus muß vorher geprüft worden sein}
  621. {     Koordinatenbereich wird verdoppelt, um Maustreiber eine echte }
  622. {     Auflösung 0..MausMaxX,0..MausMaxY in Einerschritten abzuringen}
  623. BEGIN
  624.  writeln(8);
  625.  
  626.  DisableMouse;
  627.  mouseX2:=MausMinX*2;  mouseY2:=MausMinY*2;
  628.  MausX:=mouseX2 SHR 1; MausY:=mouseY2 SHR 1;
  629.  MausXalt:=MausX;      MausYalt:=MausY;
  630.  MouseUpdate:=FALSE;   LeftButton:=FALSE; RightButton:=FALSE;
  631.  
  632.  writeln(7);
  633.  
  634.  (* regs.ax := 0; Intr($33,regs); {Maustreiber initialisieren} *)
  635.  PushAll;
  636.  ASM
  637.    MOV DI,OFFSET(@RestoreSS)
  638.    MOV CS:[DI+1],SS
  639.    MOV DI,OFFSET(@RestoreSP)
  640.    MOV CS:[DI+1],SP
  641.  
  642.    mov ax,0
  643.    int 33h
  644.  
  645.    @RestoreSS:
  646.    MOV SP,1234h
  647.    MOV SS,SP
  648.    @RestoreSP:
  649.    MOV SP,1234h
  650.  END;
  651.  PopAll;
  652.  
  653.  writeln(6);
  654.  
  655.  (* regs.ax := 2; Intr($33,regs); {Cursor aus} *)
  656.  PushAll;
  657.  ASM
  658.    MOV DI,OFFSET(@RestoreSS)
  659.    MOV CS:[DI+1],SS
  660.    MOV DI,OFFSET(@RestoreSP)
  661.    MOV CS:[DI+1],SP
  662.  
  663.    mov ax,2
  664.    int 33h
  665.  
  666.    @RestoreSS:
  667.    MOV SP,1234h
  668.    MOV SS,SP
  669.    @RestoreSP:
  670.    MOV SP,1234h
  671.  END;
  672.  PopAll;
  673.  
  674.  writeln(5);
  675.  
  676.  (* regs.ax := 4; regs.cx := 0; regs.dx := 0; *)
  677.  (* Intr($33,regs); {Maus in die obere linke Ecke setzen...} *)
  678.  PushAll;
  679.  ASM
  680.    MOV DI,OFFSET(@RestoreSS)
  681.    MOV CS:[DI+1],SS
  682.    MOV DI,OFFSET(@RestoreSP)
  683.    MOV CS:[DI+1],SP
  684.  
  685.    mov ax,4
  686.    mov cx,0
  687.    mov dx,0
  688.    int 33h
  689.  
  690.    @RestoreSS:
  691.    MOV SP,1234h
  692.    MOV SS,SP
  693.    @RestoreSP:
  694.    MOV SP,1234h
  695.  END;
  696.  PopAll;
  697.  
  698.  Writeln(4);
  699.  
  700.  (* regs.ax := 7; regs.cx := 0; regs.dx := MausMaxX*2; *)
  701.  (* Intr($33,regs); {x-Koordinatenbereich definieren}  *)
  702.  PushAll;
  703.  ASM
  704.    MOV DI,OFFSET(@RestoreSS)
  705.    MOV CS:[DI+1],SS
  706.    MOV DI,OFFSET(@RestoreSP)
  707.    MOV CS:[DI+1],SP
  708.  
  709.    mov ax,7
  710.    mov cx,0
  711.    mov dx,MausMaxX_mul2
  712.    int 33h
  713.  
  714.    @RestoreSS:
  715.    MOV SP,1234h
  716.    MOV SS,SP
  717.    @RestoreSP:
  718.    MOV SP,1234h
  719.  END;
  720.  PopAll;
  721.  
  722.  Writeln(3);
  723.  
  724.  (* regs.ax := 8; regs.cx := 0; regs.dx := MausMaxY*2; *)
  725.  (* Intr($33,regs); {y-Koordinatenbereich definieren}  *)
  726.  PushAll;
  727.  ASM
  728.    MOV DI,OFFSET(@RestoreSS)
  729.    MOV CS:[DI+1],SS
  730.    MOV DI,OFFSET(@RestoreSP)
  731.    MOV CS:[DI+1],SP
  732.  
  733.    mov ax,8
  734.    mov cx,0
  735.    mov dx,MausMaxY_mul2
  736.    int 33h
  737.  
  738.    @RestoreSS:
  739.    MOV SP,1234h
  740.    MOV SS,SP
  741.    @RestoreSP:
  742.    MOV SP,1234h
  743.  END;
  744.  PopAll;
  745.  
  746.  writeln(2);
  747.  
  748.  (* regs.ax := 12; *)
  749.  (* regs.cx := MouseMoved OR LeftButtonPressed OR RightButtonPressed; *)
  750.  (* regs.es := seg(MouseCallBack); regs.dx := ofs(MouseCallBack); *)
  751.  (* intr($33,regs); {Eigenen ISR installieren} *)
  752.  PushAll;
  753.  ASM
  754.    MOV DI,OFFSET(@RestoreSS)
  755.    MOV CS:[DI+1],SS
  756.    MOV DI,OFFSET(@RestoreSP)
  757.    MOV CS:[DI+1],SP
  758.  
  759.    mov ax,12
  760.    mov cx,MouseMoved OR LeftButtonPressed OR RightButtonPressed
  761.    mov dx,SEG MouseCallBack
  762.    mov es,dx
  763.    mov dx,OFFSET MouseCallBack
  764.    int 33h
  765.  
  766.    @RestoreSS:
  767.    MOV SP,1234h
  768.    MOV SS,SP
  769.    @RestoreSP:
  770.    MOV SP,1234h
  771.  END;
  772.  PopAll;
  773.  
  774.  writeln(1);
  775. END;
  776.  
  777.  
  778. {------- noch ein paar Popup-Boxen definieren: --------}
  779. CONST ButtonWidth=(SizeOf(ButtonStringTyp)-1)*8; {Länge einer Textbox}
  780.       EventOk=100;
  781.       abfrage:ARRAY[1..2] OF box=(
  782.  {"Ok"-Box:}
  783.        (x1:0; y1:0; x2:0; y2:0;
  784.         Name1:'';Name2:'';
  785.         Show :Dummy;
  786.         Event:EventOk;
  787.         Click:TRUE;     {Anclicken nötig}
  788.         Paint:FALSE),   {zeichnen tun wir selber!}
  789.  
  790.        {Sentinelwert, da x1>x2!}
  791.        (x1:1; y1:0; x2:0; y2:0;
  792.         Name1:'';Name2:'';
  793.         Show :Dummy;
  794.         Event:EventNone;
  795.         Click:TRUE;
  796.         Paint:TRUE)
  797.       );
  798.  
  799.       {-------------------}
  800.  
  801.       EventYes=101;
  802.       EventNo=102;
  803.       alternative:ARRAY[1..3] OF box=(
  804.  {"Ja"/"Nein"-Box:}
  805.        {"Ja"-Box:}
  806.        (x1:0; y1:0; x2:0; y2:0;
  807.         Name1:'';Name2:'';
  808.         Show :Dummy;
  809.         Event:EventYes;
  810.         Click:TRUE;     {Anclicken nötig}
  811.         Paint:FALSE),   {zeichnen tun wir selber!}
  812.  
  813.        {"Nein"-Box:}
  814.        (x1:0; y1:0; x2:0; y2:0;
  815.         Name1:'';Name2:'';
  816.         Show :Dummy;
  817.         Event:EventNo;
  818.         Click:TRUE;
  819.         Paint:FALSE),
  820.  
  821.        {Sentinelwert, da x1>x2!}
  822.        (x1:1; y1:0; x2:0; y2:0;
  823.         Name1:'';Name2:'';
  824.         Show :Dummy;
  825.         Event:EventNone;
  826.         Click:TRUE;
  827.         Paint:TRUE)
  828.       );
  829.  
  830.       {-------------------}
  831.  
  832. VAR oldGraph:pointer;
  833.     oldGraphSize:WORD;
  834.  
  835. {-----Hintergrundbildspeicher: -----------}
  836. CONST XMAX=319; {Abmessungen einer Hintergrunddatei}
  837.       YMAX=199;
  838.       LINESIZE=(XMAX+1) DIV 4;    {Groesse einer Zeile=80 Bytes}
  839.       PAGESIZE=(YMAX+1)*LINESIZE; {200 Zeilen zu je 320/4 Bytes}
  840. TYPE bitmap=ARRAY[0..PAGESIZE-1] OF BYTE;
  841.      bitmapPtr=^bitmap;
  842.      bild=ARRAY[0..3] OF bitmapPtr;
  843.  
  844. {-----Fehlerbehandlung: ------------------}
  845. CONST {Fehlercodes: }
  846.       ErrNone=0;
  847.       Error:BYTE=ErrNone;
  848.  
  849. {-----Palette: --------------------------}
  850. TYPE PaletteEntry=RECORD red,green,blue:BYTE END;
  851.      BigPalette=ARRAY[0..255] OF PaletteEntry;
  852.      PalettePtr=^BigPalette;
  853. CONST DefaultColors:BigPalette=  {Defaultfarben-Palette; erste 16-Farben}
  854.  (                               {sind identisch zu 16-Farbmodi-Farben! }
  855.   (red:  0; green:  0; blue:  0),  {Black}
  856.   (red:  0; green:  0; blue: 42),  {Blue }
  857.   (red:  0; green: 42; blue:  0),  {Green}
  858.   (red:  0; green: 42; blue: 42),  {Cyan }
  859.   (red: 42; green:  0; blue:  0),  {Red  }
  860.   (red: 42; green:  0; blue: 42),  {Magenta   }
  861.   (red: 42; green: 21; blue:  0),  {Brown}
  862.   (red: 42; green: 42; blue: 42),  {LightGray }
  863.   (red: 21; green: 21; blue: 21),  {DarkGray  }
  864.   (red: 21; green: 21; blue: 63),  {LightBlue }
  865.   (red: 21; green: 63; blue: 21),  {LightGreen}
  866.   (red: 21; green: 63; blue: 63),  {LightCyan }
  867.   (red: 63; green: 21; blue: 21),  {LightRed  }
  868.   (red: 63; green: 21; blue: 63),  {LightMagenta}
  869.   (red: 63; green: 63; blue: 21),  {Yellow}
  870.   (red: 63; green: 63; blue: 63),  {White }
  871.   (red:  0; green:  0; blue:  0),
  872.   (red:  5; green:  5; blue:  5),
  873.   (red:  8; green:  8; blue:  8),
  874.   (red: 11; green: 11; blue: 11),
  875.   (red: 14; green: 14; blue: 14),
  876.   (red: 17; green: 17; blue: 17),
  877.   (red: 20; green: 20; blue: 20),
  878.   (red: 24; green: 24; blue: 24),
  879.   (red: 28; green: 28; blue: 28),
  880.   (red: 32; green: 32; blue: 32),
  881.   (red: 36; green: 36; blue: 36),
  882.   (red: 40; green: 40; blue: 40),
  883.   (red: 45; green: 45; blue: 45),
  884.   (red: 50; green: 50; blue: 50),
  885.   (red: 56; green: 56; blue: 56),
  886.   (red: 63; green: 63; blue: 63),
  887.   (red:  0; green:  0; blue: 63),
  888.   (red: 16; green:  0; blue: 63),
  889.   (red: 31; green:  0; blue: 63),
  890.   (red: 47; green:  0; blue: 63),
  891.   (red: 63; green:  0; blue: 63),
  892.   (red: 63; green:  0; blue: 47),
  893.   (red: 63; green:  0; blue: 31),
  894.   (red: 63; green:  0; blue: 16),
  895.   (red: 63; green:  0; blue:  0),
  896.   (red: 63; green: 16; blue:  0),
  897.   (red: 63; green: 31; blue:  0),
  898.   (red: 63; green: 47; blue:  0),
  899.   (red: 63; green: 63; blue:  0),
  900.   (red: 47; green: 63; blue:  0),
  901.   (red: 31; green: 63; blue:  0),
  902.   (red: 16; green: 63; blue:  0),
  903.   (red:  0; green: 63; blue:  0),
  904.   (red:  0; green: 63; blue: 16),
  905.   (red:  0; green: 63; blue: 31),
  906.   (red:  0; green: 63; blue: 47),
  907.   (red:  0; green: 63; blue: 63),
  908.   (red:  0; green: 47; blue: 63),
  909.   (red:  0; green: 31; blue: 63),
  910.   (red:  0; green: 16; blue: 63),
  911.   (red: 31; green: 31; blue: 63),
  912.   (red: 39; green: 31; blue: 63),
  913.   (red: 47; green: 31; blue: 63),
  914.   (red: 55; green: 31; blue: 63),
  915.   (red: 63; green: 31; blue: 63),
  916.   (red: 63; green: 31; blue: 55),
  917.   (red: 63; green: 31; blue: 47),
  918.   (red: 63; green: 31; blue: 39),
  919.   (red: 63; green: 31; blue: 31),
  920.   (red: 63; green: 39; blue: 31),
  921.   (red: 63; green: 47; blue: 31),
  922.   (red: 63; green: 55; blue: 31),
  923.   (red: 63; green: 63; blue: 31),
  924.   (red: 55; green: 63; blue: 31),
  925.   (red: 47; green: 63; blue: 31),
  926.   (red: 39; green: 63; blue: 31),
  927.   (red: 31; green: 63; blue: 31),
  928.   (red: 31; green: 63; blue: 39),
  929.   (red: 31; green: 63; blue: 47),
  930.   (red: 31; green: 63; blue: 55),
  931.   (red: 31; green: 63; blue: 63),
  932.   (red: 31; green: 55; blue: 63),
  933.   (red: 31; green: 47; blue: 63),
  934.   (red: 31; green: 39; blue: 63),
  935.   (red: 45; green: 45; blue: 63),
  936.   (red: 49; green: 45; blue: 63),
  937.   (red: 54; green: 45; blue: 63),
  938.   (red: 58; green: 45; blue: 63),
  939.   (red: 63; green: 45; blue: 63),
  940.   (red: 63; green: 45; blue: 58),
  941.   (red: 63; green: 45; blue: 54),
  942.   (red: 63; green: 45; blue: 49),
  943.   (red: 63; green: 45; blue: 45),
  944.   (red: 63; green: 49; blue: 45),
  945.   (red: 63; green: 54; blue: 45),
  946.   (red: 63; green: 58; blue: 45),
  947.   (red: 63; green: 63; blue: 45),
  948.   (red: 58; green: 63; blue: 45),
  949.   (red: 54; green: 63; blue: 45),
  950.   (red: 49; green: 63; blue: 45),
  951.   (red: 45; green: 63; blue: 45),
  952.   (red: 45; green: 63; blue: 49),
  953.   (red: 45; green: 63; blue: 54),
  954.   (red: 45; green: 63; blue: 58),
  955.   (red: 45; green: 63; blue: 63),
  956.   (red: 45; green: 58; blue: 63),
  957.   (red: 45; green: 54; blue: 63),
  958.   (red: 45; green: 49; blue: 63),
  959.   (red:  0; green:  0; blue: 28),
  960.   (red:  7; green:  0; blue: 28),
  961.   (red: 14; green:  0; blue: 28),
  962.   (red: 21; green:  0; blue: 28),
  963.   (red: 28; green:  0; blue: 28),
  964.   (red: 28; green:  0; blue: 21),
  965.   (red: 28; green:  0; blue: 14),
  966.   (red: 28; green:  0; blue:  7),
  967.   (red: 28; green:  0; blue:  0),
  968.   (red: 28; green:  7; blue:  0),
  969.   (red: 28; green: 14; blue:  0),
  970.   (red: 28; green: 21; blue:  0),
  971.   (red: 28; green: 28; blue:  0),
  972.   (red: 21; green: 28; blue:  0),
  973.   (red: 14; green: 28; blue:  0),
  974.   (red:  7; green: 28; blue:  0),
  975.   (red:  0; green: 28; blue:  0),
  976.   (red:  0; green: 28; blue:  7),
  977.   (red:  0; green: 28; blue: 14),
  978.   (red:  0; green: 28; blue: 21),
  979.   (red:  0; green: 28; blue: 28),
  980.   (red:  0; green: 21; blue: 28),
  981.   (red:  0; green: 14; blue: 28),
  982.   (red:  0; green:  7; blue: 28),
  983.   (red: 14; green: 14; blue: 28),
  984.   (red: 17; green: 14; blue: 28),
  985.   (red: 21; green: 14; blue: 28),
  986.   (red: 24; green: 14; blue: 28),
  987.   (red: 28; green: 14; blue: 28),
  988.   (red: 28; green: 14; blue: 24),
  989.   (red: 28; green: 14; blue: 21),
  990.   (red: 28; green: 14; blue: 17),
  991.   (red: 28; green: 14; blue: 14),
  992.   (red: 28; green: 17; blue: 14),
  993.   (red: 28; green: 21; blue: 14),
  994.   (red: 28; green: 24; blue: 14),
  995.   (red: 28; green: 28; blue: 14),
  996.   (red: 24; green: 28; blue: 14),
  997.   (red: 21; green: 28; blue: 14),
  998.   (red: 17; green: 28; blue: 14),
  999.   (red: 14; green: 28; blue: 14),
  1000.   (red: 14; green: 28; blue: 17),
  1001.   (red: 14; green: 28; blue: 21),
  1002.   (red: 14; green: 28; blue: 24),
  1003.   (red: 14; green: 28; blue: 28),
  1004.   (red: 14; green: 24; blue: 28),
  1005.   (red: 14; green: 21; blue: 28),
  1006.   (red: 14; green: 17; blue: 28),
  1007.   (red: 20; green: 20; blue: 28),
  1008.   (red: 22; green: 20; blue: 28),
  1009.   (red: 24; green: 20; blue: 28),
  1010.   (red: 26; green: 20; blue: 28),
  1011.   (red: 28; green: 20; blue: 28),
  1012.   (red: 28; green: 20; blue: 26),
  1013.   (red: 28; green: 20; blue: 24),
  1014.   (red: 28; green: 20; blue: 22),
  1015.   (red: 28; green: 20; blue: 20),
  1016.   (red: 28; green: 22; blue: 20),
  1017.   (red: 28; green: 24; blue: 20),
  1018.   (red: 28; green: 26; blue: 20),
  1019.   (red: 28; green: 28; blue: 20),
  1020.   (red: 26; green: 28; blue: 20),
  1021.   (red: 24; green: 28; blue: 20),
  1022.   (red: 22; green: 28; blue: 20),
  1023.   (red: 20; green: 28; blue: 20),
  1024.   (red: 20; green: 28; blue: 22),
  1025.   (red: 20; green: 28; blue: 24),
  1026.   (red: 20; green: 28; blue: 26),
  1027.   (red: 20; green: 28; blue: 28),
  1028.   (red: 20; green: 26; blue: 28),
  1029.   (red: 20; green: 24; blue: 28),
  1030.   (red: 20; green: 22; blue: 28),
  1031.   (red:  0; green:  0; blue: 16),
  1032.   (red:  4; green:  0; blue: 16),
  1033.   (red:  8; green:  0; blue: 16),
  1034.   (red: 12; green:  0; blue: 16),
  1035.   (red: 16; green:  0; blue: 16),
  1036.   (red: 16; green:  0; blue: 12),
  1037.   (red: 16; green:  0; blue:  8),
  1038.   (red: 16; green:  0; blue:  4),
  1039.   (red: 16; green:  0; blue:  0),
  1040.   (red: 16; green:  4; blue:  0),
  1041.   (red: 16; green:  8; blue:  0),
  1042.   (red: 16; green: 12; blue:  0),
  1043.   (red: 16; green: 16; blue:  0),
  1044.   (red: 12; green: 16; blue:  0),
  1045.   (red:  8; green: 16; blue:  0),
  1046.   (red:  4; green: 16; blue:  0),
  1047.   (red:  0; green: 16; blue:  0),
  1048.   (red:  0; green: 16; blue:  4),
  1049.   (red:  0; green: 16; blue:  8),
  1050.   (red:  0; green: 16; blue: 12),
  1051.   (red:  0; green: 16; blue: 16),
  1052.   (red:  0; green: 12; blue: 16),
  1053.   (red:  0; green:  8; blue: 16),
  1054.   (red:  0; green:  4; blue: 16),
  1055.   (red:  8; green:  8; blue: 16),
  1056.   (red: 10; green:  8; blue: 16),
  1057.   (red: 12; green:  8; blue: 16),
  1058.   (red: 14; green:  8; blue: 16),
  1059.   (red: 16; green:  8; blue: 16),
  1060.   (red: 16; green:  8; blue: 14),
  1061.   (red: 16; green:  8; blue: 12),
  1062.   (red: 16; green:  8; blue: 10),
  1063.   (red: 16; green:  8; blue:  8),
  1064.   (red: 16; green: 10; blue:  8),
  1065.   (red: 16; green: 12; blue:  8),
  1066.   (red: 16; green: 14; blue:  8),
  1067.   (red: 16; green: 16; blue:  8),
  1068.   (red: 14; green: 16; blue:  8),
  1069.   (red: 12; green: 16; blue:  8),
  1070.   (red: 10; green: 16; blue:  8),
  1071.   (red:  8; green: 16; blue:  8),
  1072.   (red:  8; green: 16; blue: 10),
  1073.   (red:  8; green: 16; blue: 12),
  1074.   (red:  8; green: 16; blue: 14),
  1075.   (red:  8; green: 16; blue: 16),
  1076.   (red:  8; green: 14; blue: 16),
  1077.   (red:  8; green: 12; blue: 16),
  1078.   (red:  8; green: 10; blue: 16),
  1079.   (red: 11; green: 11; blue: 16),
  1080.   (red: 12; green: 11; blue: 16),
  1081.   (red: 13; green: 11; blue: 16),
  1082.   (red: 15; green: 11; blue: 16),
  1083.   (red: 16; green: 11; blue: 16),
  1084.   (red: 16; green: 11; blue: 15),
  1085.   (red: 16; green: 11; blue: 13),
  1086.   (red: 16; green: 11; blue: 12),
  1087.   (red: 16; green: 11; blue: 11),
  1088.   (red: 16; green: 12; blue: 11),
  1089.   (red: 16; green: 13; blue: 11),
  1090.   (red: 16; green: 15; blue: 11),
  1091.   (red: 16; green: 16; blue: 11),
  1092.   (red: 15; green: 16; blue: 11),
  1093.   (red: 13; green: 16; blue: 11),
  1094.   (red: 12; green: 16; blue: 11),
  1095.   (red: 11; green: 16; blue: 11),
  1096.   (red: 11; green: 16; blue: 12),
  1097.   (red: 11; green: 16; blue: 13),
  1098.   (red: 11; green: 16; blue: 15),
  1099.   (red: 11; green: 16; blue: 16),
  1100.   (red: 11; green: 15; blue: 16),
  1101.   (red: 11; green: 13; blue: 16),
  1102.   (red: 11; green: 12; blue: 16),
  1103.   (red:  0; green:  0; blue:  0),
  1104.   (red:  0; green:  0; blue:  0),
  1105.   (red:  0; green:  0; blue:  0),
  1106.   (red:  0; green:  0; blue:  0),
  1107.   (red:  0; green:  0; blue:  0),
  1108.   (red:  0; green:  0; blue:  0),
  1109.   (red:  0; green:  0; blue:  0),
  1110.   (red:  0; green:  0; blue:  0)
  1111.  );
  1112. VAR ActualColors :BigPalette;{aktuelle Farben}
  1113.  
  1114. FUNCTION PalEqual(p1,p2:BigPalette):BOOLEAN;
  1115. { in: p1,p2 = zu vergleichende Paletten}
  1116. {out: p1=p2 }
  1117. VAR i:WORD;
  1118.     flag:BOOLEAN;
  1119. BEGIN
  1120.  i:=0;
  1121.  REPEAT
  1122.   flag:=    (p1[i].red  =p2[i].red)
  1123.         AND (p1[i].green=p2[i].green)
  1124.         AND (p1[i].blue =p2[i].blue);
  1125.   inc(i);
  1126.  UNTIL (i>255) OR (NOT flag);
  1127.  PalEqual:=flag
  1128. END;
  1129.  
  1130. PROCEDURE GetBigPalette(VAR pal:BigPalette); ASSEMBLER;
  1131. { in: pal = Zeiger auf Palette-Speicher}
  1132. {out: pal = momentan aktueller Inhalt der 256-Farben CLUT}
  1133. ASM
  1134.    CLI
  1135.    XOR AL,AL
  1136.    MOV DX,3C7h
  1137.    OUT DX,AL
  1138.    LES DI,pal
  1139.    MOV CX,768
  1140.    MOV DX,3C9h
  1141.   @L1:
  1142.    IN AL,DX
  1143.    STOSB
  1144.    LOOP @L1
  1145.    STI
  1146. END;
  1147.  
  1148. FUNCTION BestFit(Color:BYTE):BYTE; ASSEMBLER;
  1149. { in: Color = Farbnummer des 16 Farbmodus, die approximiert werden soll}
  1150. {     ActualColors = gerade gesetzte 256 Farben}
  1151. {     DefaultColors= Tabelle der Defaultfarben der 16 (256) Farbmodi}
  1152. {out: Farbnummer, deren Farbe am ehesten der uebergebenen Farbe entspricht}
  1153. {rem: von Defaultcolors werden nur die ersten 16 Eintraege benoetigt, um  }
  1154. {     die Umsetzung Farbname -> RGB-Tripel machen zu koennen!}
  1155. ASM
  1156.   MOV BL,Color
  1157.   XOR BH,BH
  1158.   MOV SI,BX
  1159.   SHL SI,1
  1160.   ADD SI,BX
  1161.   ADD SI,OFFSET DefaultColors
  1162.   MOV BX,[SI]
  1163.   MOV DH,[SI+2]    {BL/BH/DH = aktuelle Farbe, RGB}
  1164.  
  1165.   PUSH BP
  1166.   MOV DI,65535     {DI=bisher gefundenes minimales Fehlerquadrat}
  1167.   MOV CX,255
  1168.   MOV SI,OFFSET ActualColors  {DS:SI = Zeiger auf aktuelle Farben}
  1169.  
  1170.  @searchloop:
  1171.      MOV AL,BL
  1172.      SUB AL,[SI]   {Farbdifferenz im Rotanteil}
  1173.      IMUL AL       {Fehler*quadrat* optimieren}
  1174.      MOV BP,AX
  1175.  
  1176.      MOV AL,BH     {dto., Gruenanteil}
  1177.      SUB AL,[SI+1]
  1178.      IMUL AL
  1179.      ADD BP,AX
  1180.      JC @noNewMin
  1181.  
  1182.      MOV AL,DH     {dto., Blauanteil}
  1183.      SUB AL,[SI+2]
  1184.      IMUL AL
  1185.      ADD AX,BP
  1186.      JC @noNewMin
  1187.  
  1188.      CMP AX,DI
  1189.      JAE @noNewMin
  1190.      MOV DI,AX
  1191.      MOV DL,CL     {100h-DL=bisher optimale Farbe}
  1192.     @noNewMin:
  1193.      ADD SI,3      {naechste Farbe zum Vergleich}
  1194.      LOOP @searchloop
  1195.  
  1196.   POP BP
  1197.  
  1198.   MOV AL,DL
  1199.   NOT AL           {AL:=100h-DL = optimale Farbe}
  1200.   XOR AH,AH
  1201. END;
  1202.  
  1203. PROCEDURE SetPalette(pal:BigPalette);
  1204. { in: pal = Zeiger auf zu setzende Palette }
  1205. {     StatusReg = Statusregister der VGA-Karte}
  1206. {out: Best* = Farbnummern der gerade gesetzten}
  1207. {     Palette, die den Fraben am ähnlichsten sind }
  1208. {rem: Palette wurde uebernommen}
  1209. VAR p:PalettePtr;
  1210. BEGIN
  1211.  p:=@pal; {Trick, da der Assembler nicht mit dem SS-Segment klarkommt}
  1212.  ASM
  1213.    mov dx,StatusReg
  1214.  
  1215.    PUSH DS
  1216.    LDS SI,p
  1217.  
  1218.    CLI
  1219.   @WaitNotVSyncLoop:
  1220.     in   al,dx
  1221.     and  al,8
  1222.     jnz  @WaitNotVSyncLoop
  1223.   @WaitVSyncLoop:
  1224.     in   al,dx
  1225.     and  al,8
  1226.     jz   @WaitVSyncLoop
  1227.  
  1228.    MOV DX,3C8h
  1229.    XOR AL,AL
  1230.    OUT DX,AL
  1231.    INC DX
  1232.  
  1233.    MOV CX,256
  1234.   @L1:
  1235.    LODSB
  1236.    OUT DX,AL
  1237.    LODSB
  1238.    OUT DX,AL
  1239.    LODSB
  1240.    OUT DX,AL
  1241.    LOOP @L1
  1242.  
  1243.    STI
  1244.    POP DS
  1245.  END; {of ASM}
  1246.  BestWhite:=BestFit(White);
  1247.  BestBlack:=BestFit(Black);
  1248.  BestCyan :=BestFit(Cyan);
  1249.  BestLightGray:=BestFit(LightGray);
  1250.  BestDarkGray:=BestFit(DarkGray);
  1251. END;
  1252.  
  1253. PROCEDURE SetPaletteEntry(nr,rot,gruen,blau:BYTE); ASSEMBLER;
  1254. { in: nr = zu setzende Farbe}
  1255. {     rot,gruen,blau = deren RGB-Werte (0..63)}
  1256. {     StatusReg = Portadresse des VGA-Statusregisters}
  1257. {out: - }
  1258. {rem: Die entsprechende Farbe wurde verändert}
  1259. ASM
  1260.   MOV AH,rot
  1261.   MOV BL,gruen
  1262.   MOV BH,blau
  1263.   MOV SI,3C8h
  1264.   MOV CL,nr
  1265.   MOV DX,StatusReg
  1266.  
  1267.   CLI
  1268.  @WaitNotHSync:
  1269.   IN AL,DX
  1270.   TEST AL,1
  1271.   JNE @WaitNotHSync
  1272.  @WaitHSync:
  1273.   IN AL,DX
  1274.   TEST AL,1
  1275.   JE @WaitHSync
  1276.  
  1277.   MOV DX,SI
  1278.   MOV AL,CL
  1279.   OUT DX,AL    {Farbnr. an 3C8h}
  1280.   INC DX
  1281.   MOV AL,AH
  1282.   OUT DX,AL    {rot an 3C9h}
  1283.   MOV AL,BL
  1284.   OUT DX,AL    {gruen auch}
  1285.   MOV AL,BH
  1286.   OUT DX,AL    {blau auch}
  1287.   STI
  1288. END;
  1289.  
  1290.  
  1291. {---------------------------------------------}
  1292. var n,x,y,button:integer;
  1293.     s:String[5];
  1294.     ch,ch2:Char;
  1295.     buttonzahl,i,j:Integer;
  1296.     FarbenStartX,FarbenStartY,FarbenHoehegesamt,
  1297.     Koordmeldx,Koordmeldy,        {Koordinaten für X/Y-Angabe}
  1298.     FilenameStartX,FilenameStartY:Integer; {dto., für Filename}
  1299.     PalnameStartX ,PalnameStartY :Integer; {dto., für Filename}
  1300.     Filenamelang,Filenamekurz: PathStr; {Dateinamen mit/ohne Pfadangabe}
  1301.     Palnamelang ,Palnamekurz : PathStr; {Palettennnamen m/o Pfadangabe }
  1302.     oldNamelang ,oldNamekurz : PathStr;
  1303.     Wahl:WORD;
  1304.  
  1305. PROCEDURE ErrBeep;
  1306. BEGIN
  1307.  sound(100); delay(300); nosound;
  1308. END;
  1309.  
  1310. function DetectVGA256 : Integer; FAR;
  1311. VAR ch:CHAR;
  1312. begin
  1313.  ClrScr;
  1314.  WRITELN('Select one of the following graphic modes:');
  1315.  WRITELN('320x200x256  = 0 ');
  1316.  WRITELN('640x400x256  = 1 ');
  1317.  WRITELN('640x480x256  = 2 ');
  1318.  WRITELN('800x600x256  = 3 ');
  1319.  WRITELN('1024x768x256 = 4 ');
  1320.  WRITELN;
  1321.  WRITELN('ATTENTION! Depending on your VGA''s chipset, some of the modes may not be');
  1322.  WRITELN('supported by your system.');
  1323.  REPEAT
  1324.   WRITE('Your choice: ');
  1325.   ch:=ReadKey;
  1326.   CASE ch OF
  1327.    '0': DetectVGA256 := SVGA320x200x256;
  1328.    '1': DetectVGA256 := SVGA640x400x256;
  1329.    '2': DetectVGA256 := SVGA640x480x256;
  1330.    '3': DetectVGA256 := SVGA800x600x256;
  1331.    '4': DetectVGA256 := SVGA1024x768x256;
  1332.    ELSE BEGIN
  1333.          WRITELN(ch);
  1334.          WRITELN('Gee man, I said: a number between 0..4!');
  1335.          Sound(200); Delay(200); Nosound;
  1336.         END;
  1337.   END;
  1338.  UNTIL ch IN ['0'..'4'];
  1339. end;
  1340.  
  1341. VAR GraphMode,GraphDriver:INTEGER;
  1342.  
  1343. PROCEDURE InitGrafikDisplay;
  1344. VAR Fehler : integer;
  1345.     Size   : LongInt;
  1346. BEGIN
  1347.  GraphDriver := detect;
  1348.  InitGraph(GraphDriver,GraphMode,'');
  1349.  Fehler:=GraphResult;
  1350.  
  1351.  IF Fehler<>GrOK
  1352.   THEN BEGIN
  1353.         restorecrtmode;
  1354.         WRITELN('*** Error while initializing graphic:');
  1355.         CASE Fehler OF
  1356.          -2:WRITELN('No graphic card found.');
  1357.          -3:WRITELN('Could not find *.BGI-driver.');
  1358.          -4:WRITELN('Graphic driver has wrong format.');
  1359.          -5:WRITELN('Not enough memory to load graphic driver.');
  1360.          else WRITELN('Errorcode: ',Fehler);
  1361.         END;
  1362.         Halt(1);
  1363.        END;
  1364.  
  1365.  Fehler:=GraphResult;
  1366.  
  1367.  IF Fehler<>0
  1368.   THEN BEGIN
  1369.         restorecrtmode;
  1370.         WRITELN('*** Unknown graphic error (while trying to switch into'+
  1371.                 ' the 256-color-mode).');
  1372.         WRITELN('Errorcode: ',Fehler);
  1373.        END
  1374.   ELSE BEGIN
  1375.         ActualColors:=DefaultColors;
  1376.         SetPalette(ActualColors);   {aktuelle Farben=Defaultfarben}
  1377.        END;
  1378.   
  1379. END;
  1380.  
  1381. PROCEDURE ShowCursorDaten;
  1382. { in: MausX,MausY = aktuelle Mauskoordinaten, innerhalb der Workarea!}
  1383. {     zoom = aktueller Zoomfaktor}
  1384. {out: Ausgabe der relativen Mauskoordinaten bzgl. der Workarea am Schirm}
  1385. {     und der Farbe unter dem Mauscursor}
  1386. {rem: Dieselben Koordinaten werden im Hauptprogramm nochmals benötigt, }
  1387. {     bei einer Änderung dort also auch ändern!}
  1388. VAR relX,relY:INTEGER;
  1389.     b:BYTE;
  1390.     s:STRING[3];
  1391. BEGIN
  1392. END;
  1393.  
  1394. FUNCTION sign(a:INTEGER):INTEGER;
  1395. BEGIN
  1396.  IF a<0 THEN sign:=-1
  1397.  ELSE IF a>0 THEN sign:=+1
  1398.  ELSE sign:=0
  1399. END;
  1400.  
  1401.  
  1402. PROCEDURE FindVGARegisters; ASSEMBLER;
  1403. { in: - }
  1404. {out: CRTAddress = Adresse des CRT-Ports, $3B4/$3D4 für monochrom/Farbe}
  1405. {     StatusReg  = dto., für Statusregister, $3BA/$3DA}
  1406. ASM
  1407.   MOV DX,3CCh
  1408.   IN AL,DX
  1409.   TEST AL,1
  1410.   MOV DX,3D4h
  1411.   JNZ @L1
  1412.   MOV DX,3B4h
  1413.  @L1:
  1414.   MOV CRTAddress,DX
  1415.   ADD DX,6
  1416.   MOV StatusReg,DX
  1417. END;
  1418.  
  1419. PROCEDURE init;
  1420. { prüft + initialisiert Maus, reserviert Platz für Mausmaske}
  1421. { initialisiert Grafik, sucht VGA-Karten-spezifische Grafikregister}
  1422. { reserviert Platz für Workarea-Inhalt}
  1423. { initialisiert Grafikbildschirm}
  1424. { initialisiert Variablen: Filename*, Palname*, Farben*, Koordmeld?}
  1425. { Event=EventNone}
  1426. BEGIN
  1427.  writeln(11);
  1428.  IF NOT MouseInstalled
  1429.   THEN BEGIN  {Ohne Maus läuft nix!}
  1430.         WRITELN(#7+'Error! Couldn''t detect mouse!');
  1431.         Halt(1)
  1432.        END
  1433.   ELSE BEGIN
  1434.         SwapVectors;
  1435.         initmouse;
  1436.        END;
  1437.  
  1438.  FindVGARegisters;
  1439.  InitGrafikDisplay;
  1440.  
  1441.  Event:=EventNone;
  1442.  
  1443.  MausMaxX:=GetMaxX;
  1444.  MausMaxY:=GetMaxY;
  1445.  MausMaxX_mul2:=GetMaxX*2;
  1446.  MausMaxY_mul2:=GetMaxY*2;
  1447.  Menu[1].x2:=MausMaxX; Menu[1].y2:=MausMaxY;
  1448.  oldMouse.breite:=MausMaxX-MausX+1;
  1449.  oldMouse.hoehe :=MausMaxY-MausY+1;
  1450.  MeldungX:=GetMaxX DIV 4;
  1451.  MeldungY:=GetMaxY DIV 4;
  1452.  IF (GetMaxX-MeldungX)<150 THEN MeldungX:=0;
  1453.  IF (GetMaxY-MeldungY)<100 THEN MeldungY:=0;
  1454.  
  1455.  FileNameLang:='';
  1456.  FileNameKurz:='';
  1457.  PalNameLang:='';
  1458.  PalNameKurz:='';
  1459. END;
  1460.  
  1461. PROCEDURE DrawOkBox(x1,y1,x2,y2:WORD; Text1:ButtonStringTyp;
  1462.           s1,s2,s3:STRING; VAR menu);
  1463. { in: s1|s2|s3 = auszugebende Strings}
  1464. {     Text1 = beschriftung für anzuzeigenden Button}
  1465. {     x1,y1 = linke obere Ecke der Meldungsbox (absolute Koord.)  }
  1466. {     x2,y2 = rechte untere Ecke der Meldungsbox (absolute Koord.)}
  1467. {     menu = auszugebende Menubox}
  1468. {out: oldGraph^ = alter Inhalt unter Meldebox}
  1469. {     oldGraphSize = deren Größe}
  1470. {     menu = um Koordinaten erweiterte Menubox (=für }
  1471. {     AskOkBox() vorbereitet}
  1472. {rem: Grafikmodus muß bereits aktiv sein!}
  1473. {     Length(s1|s2|s3)*8 >= x2-x1+1 !}
  1474. {     Der Meldungsboxbereich muß kleiner als 64K sein!}
  1475. {     Das Menu darf höchstens aus 10 Boxen bestehen}
  1476. VAR BoxBreite,BoxHoehe,disx,disy:INTEGER;
  1477.     x,y:WORD;
  1478.     mymenu:ARRAY[1..10] OF box ABSOLUTE menu;
  1479. BEGIN
  1480.  {alte Grafik sichern:}
  1481.  oldGraphSize:=ImageSize(x1,y1,x2,y2);
  1482.  GetMem(oldGraph,oldGraphSize);
  1483.  GetImage(x1,y1,x2,y2,oldGraph^);
  1484.  
  1485.  SetFillStyle(SolidFill,BestLightGray);
  1486.  Bar(x1,y1,x2,y2);
  1487.  SetFillStyle(SolidFill,BestWhite);
  1488.  Bar(x1,y1,x2-1,y1+1);
  1489.  Bar(x1,y1,x1+1,y2-1);
  1490.  SetFillStyle(SolidFill,BestDarkGray);
  1491.  Bar(x1,y2-1,x2,y2);
  1492.  Bar(x2-1,y1,x2,y2);
  1493.  
  1494.  BoxBreite:=Succ(x2-x1); BoxHoehe:=Succ(y2-y1);
  1495.  SetColor(BestBlack);
  1496.  y:=y1+10;
  1497.  IF s1<>''
  1498.   THEN BEGIN
  1499.         OutTextXY(x1+ (BoxBreite -(Length(s1) SHL 3)) SHR 1,y,s1);
  1500.         INC(y,10);
  1501.        END;
  1502.  IF s2<>''
  1503.   THEN BEGIN
  1504.         OutTextXY(x1+ (BoxBreite -(Length(s2) SHL 3)) SHR 1,y,s2);
  1505.         INC(y,10);
  1506.        END;
  1507.  IF s3<>''
  1508.   THEN BEGIN
  1509.         OutTextXY(x1+ (BoxBreite -(Length(s3) SHL 3)) SHR 1,y,s3);
  1510.         INC(y,10);
  1511.        END;
  1512.  
  1513.  disx:=(BoxBreite-ButtonWidth) DIV 2;
  1514.  disy:=(BoxHoehe-(y-y1)) DIV 4;
  1515.  mymenu[1].x1:=x1+disx; mymenu[1].y1:=y+disy;
  1516.  mymenu[1].x2:=x2-disx; mymenu[1].y2:=y2-disy;
  1517.  
  1518.  {Jetzt die Box einzeichnen:}
  1519.  y:=y+disy + ((y2-disy)-(y+disy)-8) SHR 1; {für's zentrieren des Textes...}
  1520.  WITH mymenu[1] DO
  1521.   BEGIN
  1522.    SetFillStyle(SolidFill,BestLightGray);
  1523.    Bar(x1,y1,x2,y2);
  1524.    SetFillStyle(SolidFill,BestWhite);
  1525.    Bar(x1,y1,x2-1,y1+1);
  1526.    Bar(x1,y1,x1+1,y2-1);
  1527.    SetFillStyle(SolidFill,BestDarkGray);
  1528.    Bar(x1,y2-1,x2,y2);
  1529.    Bar(x2-1,y1,x2,y2);
  1530.    OutTextXY(x1+ (ButtonWidth-(Length(Text1) SHL 3)) SHR 1,y,Text1);
  1531.   END;
  1532. END;
  1533.  
  1534. PROCEDURE AskOkBox(x1,y1:WORD; VAR menu);
  1535. { in: menu = komplett ausgefüllte Menubox}
  1536. {     oldGraph^ = alte Grafikdaten}
  1537. {     oldGraphSize = deren Größe  }
  1538. {out: Event = aufgetretenes Event }
  1539. {rem: Maus wird freigegeben, um lokales Menu bearbeiten zu können!}
  1540. {     Das Menu darf höchstens aus 10 Boxen bestehen}
  1541. VAR mymenu:ARRAY[1..10] OF box ABSOLUTE menu;
  1542.     ch:CHAR;
  1543. BEGIN;
  1544.  ch:=#0;
  1545.  DrawMaus;
  1546.  Event:=EventNone;
  1547.  
  1548.  {Maus freigeben:}
  1549.  ClearMouse;
  1550.  
  1551.  REPEAT
  1552.   IF MouseUpdate
  1553.    THEN BEGIN
  1554.          UndrawMaus;
  1555.          Event:=MouseEvent(mymenu);
  1556.          IF (Event=EventNone)
  1557.       THEN BEGIN {das war nichts, nochmal!}
  1558.                 DrawMaus;
  1559.                 ClearMouse;
  1560.                END;
  1561.         END;
  1562.   WHILE KeyPressed DO ch:=ReadKey;
  1563.   IF ch<>#0
  1564.    THEN Event:=EventOK; {auch per Taste abbrechbar}
  1565.  UNTIL Event<>EventNone;
  1566.  
  1567.  UndrawMaus;
  1568.  {alte Grafik wiederherstellen:}
  1569.  PutImage(x1,y1,oldGraph^,NormalPut);
  1570.  FreeMem(oldGraph,oldGraphSize);
  1571. END;
  1572.  
  1573. PROCEDURE OkBox(x1,y1,x2,y2:WORD; Text1:ButtonStringTyp;
  1574.                 s1,s2,s3:STRING; VAR menu);
  1575. { in: s1|s2|s3 = auszugebende Strings}
  1576. {     x1,y1 = linke obere Ecke der Meldungsbox (absolute Koord.)  }
  1577. {     x2,y2 = rechte untere Ecke der Meldungsbox (absolute Koord.)}
  1578. {     Text1 = Beschriftung für auszugebenden Button}
  1579. {     menu = auszugebende Ok-Box}
  1580. {out: (In menu wurden die Koordinaten verändert, was aber ohne Bedeutung}
  1581. {     sein sollte, da die übergebenen Menus eh nur für diesen Zweck ge- }
  1582. {     dacht sind)}
  1583. {     Event = aufgetretenes Event}
  1584. {rem: Grafikmodus muß bereits aktiv sein!}
  1585. {     Length(s1|s2|s3)*8 >= x2-x1+1 !}
  1586. {     Maus wird freigegeben, um lokales Menu bearbeiten zu können!}
  1587. {     Der Meldungsboxbereich muß kleiner als 64K sein!}
  1588. {     Das Menu darf höchstens aus 10 Boxen bestehen}
  1589. BEGIN
  1590.  DrawOkBox(x1,y1,x2,y2,Text1,s1,s2,s3,menu);
  1591.  AskOkBox(x1,y1,menu);
  1592. END;
  1593.  
  1594. PROCEDURE DrawFirstOfTwoBoxes(x1,y1,x2,y2:WORD;
  1595.                               Text1,Text2:ButtonStringTyp;
  1596.                               s1,s2,s3:STRING;
  1597.                               VAR menu);
  1598. { in: s1|s2|s3 = auszugebende Strings}
  1599. {     Text1|2 = Beschriftung der beiden Buttons}
  1600. {     x1,y1 = linke obere Ecke der Meldungsbox (absolute Koord.)  }
  1601. {     x2,y2 = rechte untere Ecke der Meldungsbox (absolute Koord.)}
  1602. {     menu  = auszugebndes Menu}
  1603. {out: TRUE|FALSE für erste|zweite Box angeclickt}
  1604. {     menu = um Koordinaten erweitertes Menu}
  1605. {rem: Grafikmodus muß bereits aktiv sein!}
  1606. {     Length(s1|s2|s3)*8 >= x2-x1+1 !}
  1607. {     Maus wird freigegeben, um lokales Menu bearbeiten zu können!}
  1608. {     Der Meldungsboxbereich muß kleiner als 64K sein!}
  1609. {     Das Menu darf höchstens aus 10 Boxen bestehen}
  1610. VAR BoxBreite,BoxHoehe,disx,disy:INTEGER;
  1611.     x,y:WORD;
  1612.     mymenu:ARRAY[1..10] OF box ABSOLUTE menu;
  1613. BEGIN
  1614.  {alte Grafik sichern:}
  1615.  oldGraphSize:=ImageSize(x1,y1,x2,y2);
  1616.  GetMem(oldGraph,oldGraphSize);
  1617.  GetImage(x1,y1,x2,y2,oldGraph^);
  1618.  
  1619.  SetFillStyle(SolidFill,BestLightGray);
  1620.  Bar(x1,y1,x2,y2);
  1621.  SetFillStyle(SolidFill,BestWhite);
  1622.  Bar(x1,y1,x2-1,y1+1);
  1623.  Bar(x1,y1,x1+1,y2-1);
  1624.  SetFillStyle(SolidFill,BestDarkGray);
  1625.  Bar(x1,y2-1,x2,y2);
  1626.  Bar(x2-1,y1,x2,y2);
  1627.  
  1628.  BoxBreite:=Succ(x2-x1); BoxHoehe:=Succ(y2-y1);
  1629.  SetColor(BestBlack);
  1630.  y:=y1+10;
  1631.  IF s1<>''
  1632.   THEN BEGIN
  1633.         OutTextXY(x1+ (BoxBreite -(Length(s1) SHL 3)) SHR 1,y,s1);
  1634.         INC(y,10);
  1635.        END;
  1636.  IF s2<>''
  1637.   THEN BEGIN
  1638.         OutTextXY(x1+ (BoxBreite -(Length(s2) SHL 3)) SHR 1,y,s2);
  1639.         INC(y,10);
  1640.        END;
  1641.  IF s3<>''
  1642.   THEN BEGIN
  1643.         OutTextXY(x1+ (BoxBreite -(Length(s3) SHL 3)) SHR 1,y,s3);
  1644.         INC(y,10);
  1645.        END;
  1646.  
  1647.  disx:=(BoxBreite-(ButtonWidth SHL 1)) DIV 3;
  1648.  disy:=(BoxHoehe-(y-y1)) DIV 4;
  1649.  mymenu[1].x1:=x1+disx;             mymenu[1].y1:=y+disy;
  1650.  mymenu[1].x2:=x1+disx+ButtonWidth; mymenu[1].y2:=y2-disy;
  1651.  
  1652.  mymenu[2].x1:=x2-disx-ButtonWidth; mymenu[2].y1:=y+disy;
  1653.  mymenu[2].x2:=x2-disx;             mymenu[2].y2:=y2-disy;
  1654.  
  1655.  {Jetzt die beiden Boxen einzeichnen:}
  1656.  y:=y+disy + ((y2-disy)-(y+disy)-8) SHR 1; {für's zentrieren des Textes...}
  1657.  WITH mymenu[1] DO
  1658.   BEGIN
  1659.    SetFillStyle(SolidFill,BestLightGray);
  1660.    Bar(x1,y1,x2,y2);
  1661.    SetFillStyle(SolidFill,BestWhite);
  1662.    Bar(x1,y1,x2-1,y1+1);
  1663.    Bar(x1,y1,x1+1,y2-1);
  1664.    SetFillStyle(SolidFill,BestDarkGray);
  1665.    Bar(x1,y2-1,x2,y2);
  1666.    Bar(x2-1,y1,x2,y2);
  1667.    OutTextXY(x1+ (ButtonWidth-(Length(Text1) SHL 3)) SHR 1,y,Text1);
  1668.   END;
  1669.  
  1670.  WITH mymenu[2] DO
  1671.   BEGIN
  1672.    SetFillStyle(SolidFill,BestLightGray);
  1673.    Bar(x1,y1,x2,y2);
  1674.    SetFillStyle(SolidFill,BestWhite);
  1675.    Bar(x1,y1,x2-1,y1+1);
  1676.    Bar(x1,y1,x1+1,y2-1);
  1677.    SetFillStyle(SolidFill,BestDarkGray);
  1678.    Bar(x1,y2-1,x2,y2);
  1679.    Bar(x2-1,y1,x2,y2);
  1680.    OutTextXY(x1+ (ButtonWidth-(Length(Text2) SHL 3)) SHR 1,y,Text2);
  1681.   END;
  1682.  
  1683.  DrawMaus;
  1684.  {Maus freigeben:}
  1685.  ClearMouse;
  1686. END;
  1687.  
  1688. FUNCTION AskFirstOfTwoBoxes(x1,y1:WORD; Text1,Text2:ButtonStringTyp;
  1689.                             VAR menu):BOOLEAN;
  1690. { in: menu = komplett ausgefüllte Menubox}
  1691. {     oldGraph^ = alte Grafikdaten}
  1692. {     oldGraphSize = deren Größe  }
  1693. {out: Event = aufgetretenes Event }
  1694. {rem: Maus wird freigegeben, um lokales Menu bearbeiten zu können!}
  1695. {     Das Menu darf höchstens aus 10 Boxen bestehen}
  1696. VAR ch:CHAR;
  1697.     mymenu:ARRAY[1..10] OF box ABSOLUTE menu;
  1698. BEGIN
  1699.  Event:=EventNone;
  1700.  REPEAT
  1701.   IF MouseUpdate
  1702.    THEN BEGIN
  1703.          UndrawMaus;
  1704.          Event:=MouseEvent(mymenu);
  1705.          IF (Event=EventNone)
  1706.       THEN BEGIN {das war nichts, nochmal!}
  1707.                 DrawMaus;
  1708.                 ClearMouse;
  1709.                END;
  1710.         END
  1711.    ELSE IF (KeyPressed) AND (Upcase(Text1[1])<>Upcase(Text2[1])) THEN
  1712.         BEGIN
  1713.          WHILE KeyPressed DO ch:=Upcase(ReadKey);
  1714.          IF ch=Upcase(Text1[1]) THEN Event:=mymenu[1].Event
  1715.          ELSE IF ch=Upcase(Text2[1]) THEN Event:=mymenu[2].Event;
  1716.         END;
  1717.  UNTIL Event<>EventNone;
  1718.  
  1719.  UndrawMaus;
  1720.  {alte Grafik wiederherstellen:}
  1721.  PutImage(x1,y1,oldGraph^,NormalPut);
  1722.  FreeMem(oldGraph,oldGraphSize);
  1723.  
  1724.  AskFirstOfTwoBoxes:=Event=EventYes
  1725. END;
  1726.  
  1727. FUNCTION FirstOfTwoBoxes(x1,y1,x2,y2:WORD;
  1728.                          Text1,Text2:ButtonStringTyp;
  1729.                          s1,s2,s3:STRING;
  1730.                          VAR menu):BOOLEAN;
  1731. { in: s1|s2|s3 = auszugebende Strings}
  1732. {     Text1|2 = Beschriftung der beiden Buttons}
  1733. {     x1,y1 = linke obere Ecke der Meldungsbox (absolute Koord.)  }
  1734. {     x2,y2 = rechte untere Ecke der Meldungsbox (absolute Koord.)}
  1735. {     menu = auszugebendes Menu}
  1736. {out: TRUE|FALSE für erste|zweite Box angeclickt}
  1737. {     (In "menu" wurden die Koordinaten verändert, was aber keine }
  1738. {     Probleme verursachen sollte, da die übergebenen Menus eh nur}
  1739. {     für diesen Zweck gedacht sind)}
  1740. {     Event = aufgetretenes Event}
  1741. {rem: Grafikmodus muß bereits aktiv sein!}
  1742. {     Length(s1|s2|s3)*8 >= x2-x1+1 !}
  1743. {     Maus wird freigegeben, um lokales Menu bearbeiten zu können!}
  1744. {     Der Meldungsboxbereich muß kleiner als 64K sein!}
  1745. {     Das Menu darf höchstens aus 10 Boxen bestehen}
  1746. BEGIN
  1747.  DrawFirstOfTwoBoxes(x1,y1,x2,y2,Text1,Text2,s1,s2,s3,menu);
  1748.  FirstOfTwoBoxes:=AskFirstOfTwoBoxes(x1,y1,Text1,Text2,menu);
  1749. END;
  1750.  
  1751. PROCEDURE Help;
  1752. BEGIN
  1753.  OkBox((GetMaxX-300) SHR 1,MeldungY,(GetMaxX-300) SHR 1+300,MeldungY+60,'ok',
  1754.        'To resize the box: press the left',
  1755.        'button and drag. Press the right',
  1756.        'button to save a file; ESC quits.',Abfrage);
  1757. END;
  1758.  
  1759.  
  1760.  
  1761.  
  1762.  
  1763.  
  1764.  
  1765. PROCEDURE DisplayPCXagain; FORWARD;
  1766.  
  1767. CONST MaxSize=65520;
  1768.       transparent=0;  {Farbe für durchsichtig = 0 per Definition!}
  1769.       {Farben für Text-Selektionsboxen:}
  1770.       ChoseColor=blue shl 4 + white;   {weiße Schrift auf blauem Hintergrund}
  1771.  
  1772.       Kopf=50; {size of sprite header}
  1773. TYPE spritetyp= record case Integer of
  1774.       0:(
  1775.          Zeiger_auf_Plane:Array[0..3] OF Word;   {These... }
  1776.          Breite_in_4er_Gruppen:WORD;             {...data  }
  1777.          Hoehe_in_Zeilen:WORD;                   {...use   }
  1778.          Translate:Array[1..4] OF Byte;          {...all   }
  1779.          SpriteLength:WORD;                      {...in all}
  1780.          Dummy:Array[1..10] OF Word;
  1781.          Kennung:ARRAY[1..2] OF CHAR;
  1782.          Version:BYTE;
  1783.          Modus:BYTE;
  1784.          ZeigerL,ZeigerR,ZeigerO,ZeigerU:Word;   {"Head" bytes!}
  1785.          Data:Array[0..MaxSize-Kopf] OF Byte;
  1786.         );
  1787.       1:(
  1788.          readin:Array[0..MaxSize] OF Byte;
  1789.         )
  1790.      END;
  1791.  
  1792. TYPE WorkAreaTyp=ARRAY[0..MaxSize] OF BYTE;
  1793.      PWorkAreaTyp=^WorkAreaTyp;
  1794. VAR WorkArea:RECORD
  1795.               SizeX,SizeY:WORD;  {Größe in x- und y-Richtung}
  1796.               MaxUsedX,MaxUsedY:INTEGER;
  1797.               data:PWorkAreaTyp; {Zeiger auf Datenarray}
  1798.              END;
  1799.  
  1800. PROCEDURE SaveActualColors;
  1801. { in: ActualColors = abzuspeichernde 256-Farbenpalette}
  1802. {     FileNameLang = Name der abzuspeichernden Datei; die Extension}
  1803. {                    muß allerdings noch auf ".PAL" gebracht werden}
  1804. {out: Palette wurde unter dem entsprechenden Namen abgespeichert}
  1805. VAR f:FILE;
  1806.     D:DirStr;
  1807.     N:NameStr;
  1808.     E:ExtStr;
  1809. BEGIN
  1810.  FSplit(FileNameLang,D,N,E);
  1811.  Assign(f,D+N+'.PAL');
  1812.  ReWrite(f,1);
  1813.  BlockWrite(f,ActualColors,SizeOf(ActualColors));
  1814.  Close(f)
  1815. END;
  1816.  
  1817. PROCEDURE SpeichereHintergrund; {PIC's}
  1818. { in: Filenamelang = Name der zu schreibenden Datei}
  1819. {     oldName* = alte Dateinamen}
  1820. {     Workarea^.[] = zu schreibende Daten}
  1821. {out: Falls Sprite nicht erstellt werden konnte, wurden die alten}
  1822. {     Dateinamen für Filename* wieder eingesetzt!}
  1823. {rem: Der Inhalt der Workarea wird in die Datei Filenamelang }
  1824. {     geschrieben; der Dateiname wurde bereits auf Eröffenbar-}
  1825. {     keit geprüft, ebenso, daß die Workarea nicht leer ist!  }
  1826. CONST PICHeader:STRING[3]='PIC'; {Kennung in Bilderdateien}
  1827. VAR f:File;
  1828.     s:String[20];
  1829.     i:BYTE;
  1830.     t,x,y:WORD;
  1831.     picture:Bild;
  1832.     pp:POINTER;
  1833.     pplen:WORD;
  1834.     attr:BYTE;
  1835. BEGIN
  1836.  IF MaxAvail<4*SizeOf(BitMap)
  1837.   THEN BEGIN
  1838.         attr:=TextAttr; TextColor(White); TextBackground(Blue);
  1839.         GotoXY(10,5);
  1840.         WRITE('Not enough heap memory to complete action!');
  1841.         GotoXY(10,6);
  1842.         WRITE(' needed memory   : ',4*SizeOf(BitMap):7,' bytes          ');
  1843.         GotoXY(10,7);
  1844.         WRITE(' available memory: ',MaxAvail:7,' bytes           ');
  1845.         Rahmen(9,4,52,8);
  1846.         TextAttr:=attr;
  1847.         ch:=ReadKey;
  1848.         Exit;
  1849.        END;
  1850.  Assign(f,Filenamelang);
  1851.  Rewrite(f,1);
  1852.  BlockWrite(f,PICHeader[1],Length(PICHeader));
  1853.  
  1854.  {Bilddaten zusammenstellen:}
  1855.  FOR i:=0 TO 3 DO New(picture[i]);
  1856.  FOR y:=0 TO YMAX DO
  1857.   FOR x:=0 TO XMAX SHR 2 DO
  1858.    BEGIN
  1859.     t:=y*LINESIZE;
  1860.     picture[0]^[t+x]:=Workarea.data^[y*WorkArea.SizeX +x shl 2 +0];
  1861.     picture[1]^[t+x]:=Workarea.data^[y*WorkArea.SizeX +x shl 2 +1];
  1862.     picture[2]^[t+x]:=Workarea.data^[y*WorkArea.SizeX +x shl 2 +2];
  1863.     picture[3]^[t+x]:=Workarea.data^[y*WorkArea.SizeX +x shl 2 +3];
  1864.    END;
  1865.  FOR i:=0 TO 3 DO BlockWrite(f,picture[i]^,PAGESIZE);
  1866.  Close(f);
  1867.  
  1868.  FOR i:=0 TO 3 DO Dispose(picture[i]);
  1869.  IF NOT PalEqual(ActualColors,DefaultColors)
  1870.   THEN BEGIN
  1871.         SaveActualColors;
  1872.         attr:=TextAttr; TextColor(White); TextBackground(Blue);
  1873.         GotoXY(10,5);
  1874.         WRITE(' The actually used colors differ from the ');
  1875.         GotoXY(10,6);
  1876.         WRITE(' VGA''s default color palette. Therefore,  ');
  1877.         GotoXY(10,7);
  1878.         WRITE(' the palette has been saved to disk, too! ');
  1879.         Rahmen(9,4,52,8);
  1880.         TextAttr:=attr;
  1881.         ch:=ReadKey;
  1882.        END;
  1883. END;
  1884.  
  1885.  
  1886. PROCEDURE SpeichereSprite; {COD's}
  1887. { in: Filenamelang = Name der zu schreibenden Datei}
  1888. {     oldName* = alte Dateinamen}
  1889. {out: Falls Sprite nicht erstellt werden konnte, wurden die alten}
  1890. {     Dateinamen für Filename* wieder eingesetzt!}
  1891. {rem: Der Inhalt der Workarea wird in die Datei Filenamelang }
  1892. {     geschrieben; der Dateiname wurde bereits auf Eröffenbar-}
  1893. {     keit geprüft, ebenso, daß die Workarea nicht leer ist!  }
  1894. LABEL quit;
  1895. VAR f:File;
  1896.     i,j,offset,Plane_Groesse:WORD;
  1897.     Gesamtgroesse:LONGINT;
  1898.     temp,p:Byte;
  1899.     links,rechts,oben,unten:Integer;
  1900.     fertig_li,fertig_re,fertig_ob,fertig_un:Boolean;
  1901.     Sprite:^spritetyp;  {Hier steht das eigentliche Sprite drinnen}
  1902.     s:String[20];
  1903.     s1,s2:STRING[5];
  1904.     pp:POINTER;
  1905.     pplen:WORD;
  1906.     attr:BYTE;
  1907.     ch:CHAR;
  1908. BEGIN
  1909.  IF MaxAvail<SizeOf(Sprite^)
  1910.   THEN BEGIN
  1911.         attr:=TextAttr; TextColor(White); TextBackground(Blue);
  1912.         GotoXY(10,5);
  1913.         WRITE('Not enough heap memory to complete action!');
  1914.         GotoXY(10,6);
  1915.         WRITE(' needed memory   : ',SizeOf(Sprite^):7,' bytes          ');
  1916.         GotoXY(10,7);
  1917.         WRITE(' available memory: ',MaxAvail:7,' bytes           ');
  1918.         Rahmen(9,4,52,8);
  1919.         TextAttr:=attr;
  1920.         ch:=ReadKey;
  1921.         Exit
  1922.        END;
  1923.  New(Sprite);
  1924.  FillChar(Sprite^.Readin,SizeOf(Sprite^.Readin),0);
  1925.  WITH Sprite^ DO
  1926.   BEGIN
  1927.    Translate[1]:=1; Translate[2]:=2; Translate[3]:=4; Translate[4]:=8;
  1928.    Kennung[1]:='K'; Kennung[2]:='R';
  1929.    Version:=1;
  1930.    Modus:=0;
  1931.    FOR i:=1 TO 10 DO dummy[i]:=0; {Dummywerte auf 0 setzen}
  1932.    Hoehe_in_Zeilen:=Succ(WorkArea.MaxUsedY);   {Y-Werte reichen von 0..MaxY}
  1933.    Breite_in_4er_Gruppen:=Succ(WorkArea.MaxUsedX shr 2); {0..3->1, 4..7->2, ...}
  1934.    {Anzahl Bytes pro Plane:}
  1935.    Plane_Groesse:=Hoehe_in_Zeilen*Breite_in_4er_Gruppen;
  1936.  
  1937.    {Indizes für Grenz- & Planedaten:}
  1938.    ZeigerL:=Kopf; {Fängt beim 1.Datenbyte an}
  1939.    ZeigerR:=ZeigerL+ (Hoehe_in_Zeilen*2);
  1940.    ZeigerO:=ZeigerR+ (Hoehe_in_Zeilen*2);
  1941.    ZeigerU:=ZeigerO+ (Breite_in_4er_Gruppen*4 *2);
  1942.    Zeiger_auf_Plane[0] :=ZeigerU+ (Breite_in_4er_Gruppen*4 *2);
  1943.    Zeiger_auf_Plane[1] :=Zeiger_auf_Plane[0]+ Plane_Groesse;
  1944.    Zeiger_auf_Plane[2] :=Zeiger_auf_Plane[1]+ Plane_Groesse;
  1945.    Zeiger_auf_Plane[3] :=Zeiger_auf_Plane[2]+ Plane_Groesse;
  1946.  
  1947.    {Das Sprite besteht aus: "Kopf" Bytes an Zeigern & speziellen Infos,}
  1948.    {4 Tabellen mit Planedaten, 2 Tabellen mit X-Grenzen (Wörter!),     }
  1949.    {2 Tabellen mit Y-Grenzen (Wörter, für jeden X-Wert einen!)         }
  1950.    Gesamtgroesse:=LONGINT(Kopf)+(Plane_Groesse*4)+
  1951.                   (Hoehe_in_Zeilen*2)*2+
  1952.                   (Breite_in_4er_Gruppen*4 *2)*2;
  1953.  
  1954.    IF Gesamtgroesse>SizeOf(SpriteTyp)
  1955.     THEN BEGIN
  1956.           Str(Gesamtgroesse:5,s1);
  1957.           Str(SizeOf(SpriteTyp):5,s2);
  1958.           Write(#7);
  1959.           OkBox(MeldungX,MeldungY,MeldungX+220,MeldungY+60,'ok',
  1960.                 'Sprite would be to big!',
  1961.                 '(is:'+s1+', max:'+s2+')','',Abfrage);
  1962.           Filenamelang:=oldNamelang; Filenamekurz:=oldNamekurz;
  1963.           goto quit;
  1964.          END;
  1965.  
  1966.    SpriteLength:=Gesamtgroesse;
  1967.  
  1968.    {Jetzt die eigentlichen Spritedaten berechnen:}
  1969.    offset:=0;
  1970.    FOR j:=0 TO WorkArea.MaxUsedY DO
  1971.      FOR i:=0 TO Pred(Breite_in_4er_Gruppen) DO
  1972.       BEGIN
  1973.        FOR p:=0 TO 3 DO
  1974.          Readin[Zeiger_auf_Plane[p]+offset]:=
  1975.           Workarea.data^[j*WorkArea.SizeX +(i shl 2)+p];
  1976.        inc(offset);
  1977.       END;
  1978.  
  1979.    {Nun die X-Grenzdaten für jede Zeile:}
  1980.    offset:=0;
  1981.    FOR j:=0 TO WorkArea.MaxUsedY DO
  1982.     BEGIN
  1983.      links:=0;
  1984.      rechts:=WorkArea.MaxUsedX;
  1985.      fertig_li:=false; fertig_re:=false;
  1986.      REPEAT
  1987.       if (not fertig_li and (WorkArea.data^[j*WorkArea.SizeX +links]=0))
  1988.        THEN inc(links) ELSE fertig_li:=true;
  1989.       if (not fertig_re and (WorkArea.data^[j*WorkArea.SizeX +rechts]=0))
  1990.        THEN dec(rechts) ELSE fertig_re:=true;
  1991.       if links>rechts THEN BEGIN fertig_li:=true; fertig_re:=true END;
  1992.      UNTIL fertig_li and fertig_re;
  1993.      if links>rechts
  1994.       THEN BEGIN {Leerzeile, Sentinelwerte eintragen}
  1995.             readin[ZeigerL+offset]:=lo(+16000);
  1996.             readin[Succ(ZeigerL+offset)]:=hi(+16000);
  1997.             readin[ZeigerR+offset]:=lo(-16000);
  1998.             readin[Succ(ZeigerR+offset)]:=hi(-16000)
  1999.            END
  2000.       ELSE BEGIN {normale Zeile, Grenzen eintragen}
  2001.             readin[ZeigerL+offset]:=lo(links);
  2002.             readin[Succ(ZeigerL+offset)]:=hi(links);
  2003.             readin[ZeigerR+offset]:=lo(rechts);
  2004.             readin[Succ(ZeigerR+offset)]:=hi(rechts)
  2005.            END;
  2006.      inc(offset,2)  {Grenzeinträge sind Wörter!}
  2007.     END;
  2008.  
  2009.    {Dasselbe für die Grenzdaten jeder Spalte:}
  2010.    offset:=0;
  2011.    FOR i:=0 TO Pred(Breite_in_4er_Gruppen shl 2) DO
  2012.     BEGIN
  2013.      oben :=0;
  2014.      unten:=WorkArea.MaxUsedY;
  2015.      fertig_ob:=false; fertig_un:=false;
  2016.      REPEAT
  2017.       if (not fertig_ob and (Workarea.data^[oben*WorkArea.SizeX +i]=0))
  2018.        THEN inc(oben) ELSE fertig_ob:=true;
  2019.       if (not fertig_un and (Workarea.data^[unten*WorkArea.SizeX +i]=0))
  2020.        THEN dec(unten) ELSE fertig_un:=true;
  2021.       if oben>unten THEN BEGIN fertig_ob:=true; fertig_un:=true END;
  2022.      UNTIL fertig_ob and fertig_un;
  2023.      if oben>unten
  2024.       THEN BEGIN {Leerspalte, Sentinelwerte eintragen}
  2025.             readin[ZeigerO+offset]:=lo(+16000);
  2026.             readin[Succ(ZeigerO+offset)]:=hi(+16000);
  2027.             readin[ZeigerU+offset]:=lo(-16000);
  2028.             readin[Succ(ZeigerU+offset)]:=hi(-16000)
  2029.            END
  2030.       ELSE BEGIN {normale Spalte, Grenzen eintragen}
  2031.             readin[ZeigerO+offset]:=lo(oben);
  2032.             readin[Succ(ZeigerO+offset)]:=hi(oben);
  2033.             readin[ZeigerU+offset]:=lo(unten);
  2034.             readin[Succ(ZeigerU+offset)]:=hi(unten)
  2035.            END;
  2036.      inc(offset,2)  {Grenzeinträge sind Wörter!}
  2037.     END;
  2038.  
  2039.   END; {of with}
  2040.  
  2041.  {Nun die Daten auf Disk schreiben:}
  2042.  Assign(f,Filenamelang);
  2043.  Rewrite(f,1);
  2044.  BlockWrite(f,sprite^.readin,Gesamtgroesse);
  2045.  Close(f);
  2046.  IF NOT PalEqual(ActualColors,DefaultColors)
  2047.   THEN BEGIN
  2048.         SaveActualColors;
  2049.         attr:=TextAttr; TextColor(White); TextBackground(Blue);
  2050.         GotoXY(10,5);
  2051.         WRITE(' The actually used colors differ from the ');
  2052.         GotoXY(10,6);
  2053.         WRITE(' VGA''s default color palette. Therefore,  ');
  2054.         GotoXY(10,7);
  2055.         WRITE(' the palette has been saved to disk, too! ');
  2056.         Rahmen(9,4,52,8);
  2057.         TextAttr:=attr;
  2058.         ch:=ReadKey;
  2059.        END;
  2060.  
  2061. quit:;
  2062.  Dispose(Sprite);
  2063. END;
  2064.  
  2065. FUNCTION gueltig(VAR P:InputString; Ext:ExtStr):Boolean;
  2066. { in: P = vollständiger Dateiname}
  2067. {     Ext = gewünschte Defaultextension, falls P selber keine hat}
  2068. {out: TRUE/FALSE, wenn unter dem angegebenen Namen eine Datei angelegt}
  2069. {     werden kann und deren Endung "Ext" ist}
  2070. {     P = vollständiger Dateiname, um "Ext" erweitert, wenn keine Ex- }
  2071. {     tension angegeben wurde, evtl. Leerzeichen wurden entfernt      }
  2072. {rem: Eine schon bestehende Datei gleichen Namens wird überschrieben! }
  2073. {     P muß in Großschrift sein!}
  2074. VAR i:Byte;
  2075.     D: DirStr;
  2076.     N: NameStr;
  2077.     E: ExtStr;
  2078.  
  2079.      FUNCTION eroeffenbar(P:PathStr):Boolean;
  2080.      VAR f:File;
  2081.          temp:Boolean;
  2082.      BEGIN
  2083.       assign(f,P);
  2084.       {$I-}
  2085.       rewrite(f);
  2086.       {$I+}
  2087.       temp:=ioresult=0;
  2088.       if temp THEN close(f);
  2089.       eroeffenbar:=temp
  2090.      END;
  2091.  
  2092. BEGIN
  2093.  WHILE (P[1]=' ') DO delete(P,1,1);
  2094.  WHILE (P[Length(P)]=' ') DO delete(P,Length(P),1);
  2095.  IF POS(' ',P)>0
  2096.   THEN BEGIN
  2097.         gueltig:=FALSE;
  2098.         exit
  2099.        END;
  2100.  
  2101.  FSplit(P, D, N, E);
  2102.  IF E='' THEN E:=Ext;
  2103.  P := D + N + E;
  2104.  
  2105.  if (n='')              {Kein Namen angegeben?}
  2106.   or (pos('*',p)>0)     {keine Wildcards erlaubt}
  2107.   or (pos('?',p)>0)
  2108.   or (pos(':',N+E)>0)   {LW-Angaben sind nur im Pfad erlaubt}
  2109.   or (E<>Ext)           {nur "Ext" als Endung erlaubt}
  2110.   or ( (pos(':',D)>0) and (pos(':',D)<>2) )   {":" muß an 2.Position sein}
  2111.   or (not eroeffenbar(P))
  2112.  THEN BEGIN gueltig:=false; exit END
  2113.  ELSE gueltig:=true
  2114. END;
  2115.  
  2116. PROCEDURE Speichern;
  2117. VAR Breite_in_4er_Gruppen:WORD;
  2118.     Plane_Groesse,Gesamtgroesse:LONGINT;
  2119.     s1,s2:STRING[10];
  2120.     x,y:WORD;
  2121.     c:BYTE;
  2122.  
  2123.     name:TPath;
  2124.     error:BOOLEAN;
  2125.     oldInt24h:POINTER;
  2126.  
  2127.     FUNCTION HoleFileNamen(Ext:ExtStr):BOOLEAN;
  2128.     { in: Ext = erwartete Extension (COD oder PIC)}
  2129.     CONST x1=4; y1=4; inlen=67; {Koordinaten für Eingabebox}
  2130.     VAR temp:InputString;
  2131.         abbruch:Boolean;
  2132.         size:word;
  2133.         attr:Byte;
  2134.         i:Integer;
  2135.         ch:Char;
  2136.         oldNamelang,oldNamekurz,
  2137.         P: PathStr;
  2138.         D: DirStr;
  2139.         N: NameStr;
  2140.         E: ExtStr;
  2141.     BEGIN
  2142.      {evtl. alten Filenamen aufheben}
  2143.      oldNamelang:=Filenamelang; oldNamekurz:=Filenamekurz;
  2144.  
  2145.      ClrScr;
  2146.  
  2147.      GotoXY(x1,y1-2);
  2148.      WRITE('Please give a name (*.'+Ext+') for your sprite file; <ESC> to cancel');
  2149.      GotoXY(1,y1+6);
  2150.      WRITELN('Use the following keys to edit your input:'); WRITELN;
  2151.      WRITELN('HOME/END            : move cursor to the start/end of line');
  2152.      WRITELN('LEFT/RIGHT          : move cursor one char');
  2153.      WRITELN('^LEFT/^RIGHT, ^A/^F : move cursor one word');
  2154.      WRITELN;
  2155.      WRITELN('INS, ^V             : toggle insert/overwrite mode');
  2156.      WRITELN('UP/DOWN, ^E/^X      : review the last (up to 30) input lines');
  2157.      WRITELN;
  2158.      WRITELN('^T : delete word                  DEL, ^G : delete char under cursor');
  2159.      WRITELN('^K : delete to end of line        BSPC,^H : backspace');
  2160.      WRITELN('^Y : delete whole input line      ESC     : cancel input');
  2161.  
  2162.      attr:=textattr; textattr:=ChoseColor;
  2163.  
  2164.       {Defaultwert für Namen aus Filenamelang bestimmen:}
  2165.       IF Filenamelang<>''
  2166.        THEN BEGIN {dafür sorgen, daß evtl. Extension = Ext ist}
  2167.              FSplit(Filenamelang,D,N,E);
  2168.              temp:=D+N+'.'+Ext
  2169.             END
  2170.        ELSE temp:='';
  2171.  
  2172.       abbruch:=false;         {heißt: behalte die letzten gemachten Eingaben}
  2173.       GotoXY(x1,y1+1);        {= 1.Position in der Eingabetextbox}
  2174.       BoxGetString(temp,inlen,abbruch,'enter filename:');
  2175.       textattr:=attr;
  2176.       IF abbruch
  2177.        THEN BEGIN {ESC gedrückt}
  2178.              Window(1,y1+3,80,25); ClrScr; Window(1,1,80,25);
  2179.              GotoXY(x1,y1+4);
  2180.              WRITE('You didn''t choose a file!  <any key>');
  2181.              ch:=readkey; while keypressed do ch:=readkey;
  2182.             END
  2183.        ELSE BEGIN {Dateinamen ausprobieren}
  2184.              FOR i:=1 TO Length(temp) DO
  2185.               CASE temp[i] OF
  2186.                'ä':temp[i]:='Ä';
  2187.                'ö':temp[i]:='Ö';
  2188.                'ü':temp[i]:='Ü'
  2189.                ELSE temp[i]:=upcase(temp[i])
  2190.               END;
  2191.  
  2192.              if not gueltig(temp,'.'+Ext)
  2193.               THEN BEGIN {ungültiger Dateiname}
  2194.                     Window(1,y1+3,80,25); ClrScr; Window(1,1,80,25);
  2195.                     GotoXY(x1,y1+4);
  2196.                     ClrEol; WRITELN('*** Error! Couldn''t open file with name:');
  2197.                     ClrEol; WRITELN;
  2198.                     ClrEol; WRITELN(temp);
  2199.                     ClrEol; WRITELN;
  2200.                     ClrEol; WRITE('(invalid access path or filename)!  <any key>');
  2201.                     ch:=readkey; while keypressed do ch:=readkey;
  2202.                     abbruch:=true;  {Ist auch als Abbruch zu bewerten!}
  2203.                    END
  2204.               ELSE BEGIN {gültiger Name, in Filename_* übernehmen}
  2205.                     P:=temp;
  2206.                     FSplit(P,D,N,E);
  2207.                     Filenamelang:=P;
  2208.                     Filenamekurz:=N+E;
  2209.                    END;
  2210.             END;
  2211.      HoleFileNamen:=NOT abbruch;
  2212.     END;
  2213.  
  2214. BEGIN
  2215.  WITH oldMouse DO
  2216.   BEGIN
  2217.    IF (breite=320) AND (hoehe=200)
  2218.     THEN BEGIN
  2219.           IF breite*hoehe>MaxAvail
  2220.            THEN BEGIN
  2221.                  Str(breite*hoehe:7,s1);
  2222.                  Str(MaxAvail:7,s2);
  2223.                  OkBox((GetMaxX-200) SHR 1,MeldungY,(GetMaxX-200) SHR 1+200,MeldungY+60,'ok',
  2224.                        'Not enough heap memory:',
  2225.                        'needed: '+s1,
  2226.                        'max   : '+s2,Abfrage);
  2227.                  exit;
  2228.                 END
  2229.        ELSE BEGIN
  2230.                  {nun loslegen: Speicher reservieren und Grafik auslesen}
  2231.                  GetMem(WorkArea.data,breite*hoehe);
  2232.                  WorkArea.SizeX:=breite;
  2233.                  WorkArea.SizeY:=hoehe;
  2234.                  WorkArea.MaxUsedX:=-1;
  2235.                  WorkArea.MaxUsedY:=-1;
  2236.                  FOR y:=0 TO hoehe-1 DO
  2237.               BEGIN
  2238.                    FOR x:=0 TO breite-1 DO
  2239.                 BEGIN
  2240.                      c:=GetPixel(x+oldX,y+oldY);
  2241.                      WorkArea.data^[y*breite+x]:=c;
  2242.                      IF c<>0
  2243.                   THEN BEGIN
  2244.                             WorkArea.MaxUsedY:=y;
  2245.                             IF x>WorkArea.MaxUsedX
  2246.                              THEN WorkArea.MaxUsedX:=x
  2247.                            END;
  2248.                     END;
  2249.                   END;
  2250.  
  2251.                  IF (WorkArea.MaxUsedX=0) AND (WorkArea.MaxUsedY=0) AND
  2252.                     (WorkArea.data^[0]=transparent)
  2253.                   THEN BEGIN {Workarea leer!}
  2254.                         ErrBeep;
  2255.                         OkBox((GetMaxX-200) SHR 1,MeldungY,
  2256.                               (GetMaxX-200) SHR 1+200,MeldungY+60,'ok',
  2257.                               'Workarea is empty;',
  2258.                               'nothing to do!',
  2259.                               '',Abfrage);
  2260.                         exit
  2261.                        END;
  2262.  
  2263.  
  2264.                  GetBigPalette(actualColors); {aktuelle Farbpalette merken}
  2265.  
  2266.                  RestoreCRTmode;
  2267.  
  2268.                  IF HoleFileNamen('PIC')
  2269.                   THEN BEGIN
  2270.                         SpeichereHintergrund;  {Eigentliche Daten berechnen & schreiben}
  2271.                        END;
  2272.                  FreeMem(WorkArea.data,breite*hoehe);
  2273.  
  2274.                  SetGraphMode(GetGraphMode);
  2275.                  DisplayPCXagain;
  2276.                 END; {of ELSE breite*hoehe<=MaxAvail}
  2277.  
  2278.          END {of IF (breite=320) AND (hoehe=200) }
  2279.     ELSE BEGIN
  2280.           Breite_in_4er_Gruppen:=Succ((breite-1) shr 2); {0..3->1, 4..7->2, ...}
  2281.           {Anzahl Bytes pro Plane:}
  2282.           Plane_Groesse:=LONGINT(hoehe)*Breite_in_4er_Gruppen;
  2283.           Gesamtgroesse:=LONGINT(Kopf)+(Plane_Groesse*4)+
  2284.                          (hoehe*2)*2+
  2285.                          (Breite_in_4er_Gruppen*4 *2)*2;
  2286.  
  2287.           IF Gesamtgroesse>SizeOf(SpriteTyp)
  2288.            THEN BEGIN
  2289.                  Str(Gesamtgroesse:7,s1);
  2290.                  Str(SizeOf(SpriteTyp):7,s2);
  2291.                  OkBox((GetMaxX-200) SHR 1,MeldungY,(GetMaxX-200) SHR 1+200,MeldungY+60,'ok',
  2292.                        'Sprite would be to big:',
  2293.                        'needed: '+s1,
  2294.                        'max   : '+s2,Abfrage);
  2295.                  exit;
  2296.                 END;
  2297.  
  2298.           IF breite*hoehe>SizeOf(WorkAreaTyp)
  2299.            THEN BEGIN
  2300.                  Str(breite*hoehe:7,s1);
  2301.                  Str(SizeOf(WorkAreaTyp):7,s2);
  2302.                  OkBox((GetMaxX-200) SHR 1,MeldungY,(GetMaxX-200) SHR 1+200,MeldungY+60,'ok',
  2303.                        'Sprite would be to big:',
  2304.                        'needed: '+s1,
  2305.                        'max   : '+s2,Abfrage);
  2306.                  exit;
  2307.                 END;
  2308.  
  2309.           IF breite*hoehe>MaxAvail
  2310.            THEN BEGIN
  2311.                  Str(breite*hoehe:7,s1);
  2312.                  Str(MaxAvail:7,s2);
  2313.                  OkBox((GetMaxX-200) SHR 1,MeldungY,(GetMaxX-200) SHR 1+200,MeldungY+60,'ok',
  2314.                        'Not enough heap memory:',
  2315.                        'needed: '+s1,
  2316.                        'max   : '+s2,Abfrage);
  2317.                  exit;
  2318.                 END;
  2319.  
  2320.           {nun loslegen: Speicher reservieren und Grafik auslesen}
  2321.           GetMem(WorkArea.data,breite*hoehe);
  2322.           WorkArea.SizeX:=breite;
  2323.           WorkArea.SizeY:=hoehe;
  2324.           WorkArea.MaxUsedX:=-1;
  2325.           WorkArea.MaxUsedY:=-1;
  2326.           FOR y:=0 TO hoehe-1 DO
  2327.        BEGIN
  2328.             FOR x:=0 TO breite-1 DO
  2329.          BEGIN
  2330.               c:=GetPixel(x+oldX,y+oldY);
  2331.               WorkArea.data^[y*breite+x]:=c;
  2332.               IF c<>0
  2333.            THEN BEGIN
  2334.                      WorkArea.MaxUsedY:=y;
  2335.                      IF x>WorkArea.MaxUsedX
  2336.                       THEN WorkArea.MaxUsedX:=x
  2337.                     END;
  2338.              END;
  2339.            END;
  2340.  
  2341.           IF (WorkArea.MaxUsedX=0) AND (WorkArea.MaxUsedY=0) AND
  2342.              (WorkArea.data^[0]=transparent)
  2343.            THEN BEGIN {Workarea leer!}
  2344.                  ErrBeep;
  2345.                  OkBox((GetMaxX-200) SHR 1,MeldungY,(GetMaxX-200) SHR 1+200,MeldungY+60,'ok',
  2346.                        'Workarea is empty;',
  2347.                        'nothing to do!',
  2348.                        '',Abfrage);
  2349.                  exit
  2350.                 END;
  2351.  
  2352.  
  2353.           GetBigPalette(actualColors); {aktuelle Farbpalette merken}
  2354.  
  2355.           RestoreCRTmode;
  2356.           
  2357.           IF HoleFileNamen('COD')
  2358.            THEN BEGIN
  2359.                  SpeichereSprite;  {Eigentliche Daten berechnen & schreiben}
  2360.                 END;
  2361.           FreeMem(WorkArea.data,breite*hoehe);
  2362.  
  2363.           SetGraphMode(GetGraphMode);
  2364.           DisplayPCXagain;
  2365.          END;
  2366.   END;
  2367. END;
  2368.  
  2369. {------------------- PCX-Routinen --------------------}
  2370.  
  2371. CONST MaxLineWidth=1023; {max. X-Koord. einer Zeile}
  2372.       ErrWrongPCXVersion=1;
  2373.       BufSize=2048;      {E/A-Puffergröße für schnelleren Filezugriff}
  2374.  
  2375. VAR OnePCXline:ARRAY[0..3,0..MaxLineWidth] OF BYTE;
  2376. type TPCXHeader=Record
  2377.                  Manufacturer,Version,Encoding,BitsPerPixel:BYTE;
  2378.                  xmin,ymin,xmax,ymax,hres,vres:INTEGER;
  2379.                  palette:ARRAY[0..15,0..2] OF BYTE;
  2380.                  Reserved,NPlanes:BYTE;
  2381.                  BytesPerLine,paletteinfo:INTEGER;
  2382.                  Filler:ARRAY[0..57] OF BYTE;
  2383.                 END;
  2384. CONST RLEbyte :BYTE=0;    {Anfangswerte so wählen, daß beim ersten  }
  2385.       ReadByte:BYTE=0;    {Zugriff ein Block von der Diskette einge-}
  2386.       Index:WORD=BufSize; {lesen werden wird!}
  2387.       FileDone:BOOLEAN=FALSE;
  2388. VAR Buffer:ARRAY[1..BufSize] OF BYTE;
  2389.     Header:TPCXHeader;
  2390.     PCXname:PathStr;
  2391.     MaxZeile:INTEGER;
  2392.     AnzColors:LONGINT;
  2393.     fin:FILE;
  2394.     Tag:BYTE;
  2395.     Pal256:ARRAY[0..255,0..2] OF BYTE;
  2396.     p:POINTER;
  2397.  
  2398. PROCEDURE ErrorMsg(s:STRING);
  2399. BEGIN
  2400.  WRITELN('Error: ',s);
  2401.  Halt
  2402. END;
  2403.  
  2404. FUNCTION GetByte(VAR fin:file):BYTE;
  2405. VAR n:BYTE;
  2406.  
  2407.  PROCEDURE GetNextBlock;
  2408.  VAR temp:WORD;
  2409.  BEGIN
  2410.   IF NOT EOF(fin)
  2411.    THEN BEGIN
  2412.          blockread(fin,Buffer,BufSize,temp);
  2413.          Index:=1
  2414.         END
  2415.    ELSE FileDone:=true;
  2416.  END;
  2417.  
  2418.  FUNCTION GetCh:BYTE;
  2419.  BEGIN
  2420.   IF NOT FileDone
  2421.    THEN BEGIN
  2422.          IF Index=BufSize
  2423.           THEN GetNextBlock
  2424.           ELSE Inc(Index);
  2425.          GetCh:=Buffer[Index]
  2426.         END
  2427.    ELSE GetCh:=0;
  2428.  END;
  2429.  
  2430. BEGIN
  2431.  IF RLEbyte>0
  2432.   THEN BEGIN
  2433.         GetByte:=ReadByte;
  2434.         Dec(RLEbyte);
  2435.         exit
  2436.        END;
  2437.  n:=GetCh;
  2438.  IF n AND $C0 = $C0
  2439.   THEN BEGIN {Run Length Encoded}
  2440.         ReadByte:=GetCh;
  2441.         RLEbyte:=n AND $3f -1
  2442.        END
  2443.   ELSE BEGIN {normales Databyte}
  2444.         ReadByte:=n;
  2445.         RLEbyte:=0
  2446.        END;
  2447.  GetByte:=ReadByte
  2448. END;
  2449.  
  2450. PROCEDURE ReadPCXHeader(name:PathStr; VAR Header:TPCXHeader; VAR fin:FILE);
  2451. { in: name = Name der PCX-Datei}
  2452. {out: Header = erste 128 Bytes der PCX-Datei}
  2453. {     fin = zum lesen geöffnete PCX-Datei}
  2454. VAR temp:INTEGER;
  2455. BEGIN
  2456.  {$I-}
  2457.  Assign(fin,name); Reset(fin,1); blockread(fin,Header,128);
  2458.  {$I+}
  2459.  Error:=IOResult;
  2460.  IF Error<>0
  2461.   THEN BEGIN
  2462.         {$I-} Close(fin); {$I+}
  2463.         temp:=IOResult;
  2464.         exit
  2465.        END;
  2466.  If (Header.version>5) or (Header.encoding>1)
  2467.   THEN Error:=ErrWrongPCXVersion;
  2468. END;
  2469.  
  2470. PROCEDURE DisplayPCXdata(VAR Header:TPCXHeader; MaxZeile:INTEGER;
  2471.                          VAR fin:FILE);
  2472. { in: Header   = erste 128 Bytes der PCX-Datei}
  2473. {     MaxZeile = letzte auszulesende Zeile aus der PCX-Datei}
  2474. {     fin = zum lesen geöffnete PCX-Datei}
  2475. {out: fin = geschlossene Datei}
  2476. {rem: PCX-File wurde auf dem Schirm dargestellt; Grafikmodus & Palette}
  2477. {     müssen bereits gesetzt sein}
  2478. LABEL break1;
  2479. CONST Einsen:ARRAY[1..8] OF BYTE=(1,3,7,15,31,63,127,255);
  2480. VAR i,j,k,l,x,px:INTEGER;
  2481.     p:POINTER;
  2482.     steps,Maske,cutoff:BYTE;
  2483.     c:LONGINT;
  2484. BEGIN
  2485.  {$I-} Seek(fin,128); {$I+}
  2486.  IF IOResult<>0 THEN exit;
  2487.  FOR l:=0 TO MaxZeile DO
  2488.   BEGIN
  2489.    FOR j:=0 TO Header.NPlanes-1 DO
  2490.     BEGIN
  2491.      FOR i:=0 TO Header.BytesPerLine-1 DO
  2492.       OnePCXline[j,i]:=GetByte(fin)  {*ganze* Zeile aus Datei holen}
  2493.     END;
  2494.  
  2495.    steps:=(8 DIV Header.BitsPerPixel);   {Anzahl Pixel pro Byte}
  2496.    Maske:=Einsen[Header.BitsPerPixel];   {Maske zur Isolierung eines Punktes}
  2497.    FOR x:=0 TO Header.BytesPerLine-1 DO
  2498.     BEGIN
  2499.      FOR j:=steps-1 DOWNTO 0 DO
  2500.       BEGIN
  2501.        {berechne c:=Bits der höchsten Plane||Bits der nächsten Plane||etc}
  2502.        {Beispiel: normales 16 Farbenbild (4 Planes, 1 Bit je Plane):}
  2503.        {c:=1Bit von Plane3||1Bit von Plane2||1Bit von Plane1||1Bit von Plane0}
  2504.        {Beispiel: 24Bit-Farbbild (3 Planes, 8 Bit je Plane):}
  2505.        {c:=8Bit von Plane2||8Bit von Plane1||8Bit von Plane0}
  2506.        c:=0;
  2507.        cutoff:=j*Header.BitsPerPixel; {zur Ausmaskierung der relavanten Bits}
  2508.        FOR k:=Header.NPlanes-1 DOWNTO 0 DO
  2509.         c:=(c SHL Header.BitsPerPixel)+((OnePCXline[k,x] SHR cutoff) AND Maske);
  2510.        px:=x*Steps+Pred(steps-j)*Header.BitsPerPixel;
  2511.        IF px>GetMaxX THEN goto break1; {Bild ist horizontal zu groß}
  2512.        PutPixel(px,l,c);
  2513.       END;
  2514.     END;
  2515.    break1:;
  2516.  
  2517.   END; {of FOR l}
  2518.  
  2519.  Close(fin);
  2520. END;
  2521.  
  2522. PROCEDURE DisplayPCXagain;
  2523. BEGIN
  2524.  RLEbyte :=0;
  2525.  ReadByte:=0;
  2526.  Index:=BufSize;
  2527.  FileDone:=FALSE;
  2528.  IF AnzColors=256
  2529.   THEN BEGIN {Farbpalette steht am Ende der Datei}
  2530.         FOR i:=0 TO AnzColors-1 DO
  2531.      BEGIN
  2532.           ActualColors[i].red  :=Pal256[i][0] SHR 2;
  2533.           ActualColors[i].green:=Pal256[i][1] SHR 2;
  2534.           ActualColors[i].blue :=Pal256[i][2] SHR 2;
  2535.          END;
  2536.          SetPalette(ActualColors);
  2537.        END
  2538.   ELSE IF AnzColors<=16
  2539.         THEN FOR i:=0 TO AnzColors-1 DO
  2540.               SetRGBPalette(i,Header.Palette[i][0] SHR 2,
  2541.                               Header.Palette[i][1] SHR 2,
  2542.                               Header.Palette[i][2] SHR 2);
  2543.  GetBigPalette(ActualColors);
  2544.  Assign(fin,PCXname); Reset(fin,1);
  2545.  DisplayPCXdata(Header,MaxZeile,fin);
  2546. END;
  2547.  
  2548. {------------------- Hauptprogramm -------------------}
  2549.  
  2550. BEGIN
  2551.  IF ParamCount<>1
  2552.   THEN BEGIN
  2553.         WRITELN;
  2554.         WRITELN('PCX2COD converter, V0.9ß   --by Kai Rohrbacher  (c) 1993');
  2555.         WRITELN('Converts PCX-files into *.COD or *.PIC files.');
  2556.         WRITELN;
  2557.         WRITELN('Call PCX2COD in the following way:');
  2558.         WRITELN;
  2559.         WRITELN(ParamStr(0)+' pcxfile.pcx');
  2560.         WRITELN;
  2561.         WRITELN('Use the mouse and the left button to select the part of'+
  2562.                 ' the picture');
  2563.         WRITELN('you want to convert, then press <Return> to save it.');
  2564.         Halt
  2565.        END;
  2566.  PCXname:=ParamStr(1);
  2567.  
  2568.  IF InstallUserDriver('SVGA256',@DetectVGA256)<0 {RegisterBGIDriver geht leider nicht!}
  2569.   THEN ErrorMsg('Graphic error: '+GraphErrorMsg(GraphResult));
  2570.  
  2571.  ReadPCXHeader(PCXname,Header,fin);
  2572.  IF Error<>0
  2573.   THEN ErrorMsg('Couldn''t find file '+PCXname);
  2574.  AnzColors:=1 SHL (Header.BitsPerPixel*Header.NPlanes);
  2575.  IF AnzColors=256
  2576.   THEN BEGIN {Farbpalette steht am Ende der Datei}
  2577.         Seek(fin,FileSize(fin)-769);
  2578.         BlockRead(fin,Tag,1);
  2579.         IF Tag<>$0C
  2580.      THEN BEGIN
  2581.                Close(fin);
  2582.                ErrorMsg('No true 256-color-PCX!');
  2583.               END
  2584.          ELSE BEGIN
  2585.                BlockRead(fin,Pal256,SizeOf(Pal256));
  2586.               END
  2587.        END;
  2588.  
  2589.  Init;
  2590.  
  2591.  {Farbpaletten: im PCX sind die RGB-Werte immer 8 Bit breit; der }
  2592.  {256-Farbenmodus verwendet aber nur 6 Bit, deshalb wird um 2 Bit}
  2593.  {rechts verschoben!}
  2594.  IF AnzColors=256
  2595.   THEN BEGIN {Farbpalette steht am Ende der Datei}
  2596.         FOR i:=0 TO AnzColors-1 DO
  2597.      BEGIN
  2598.           ActualColors[i].red  :=Pal256[i][0] SHR 2;
  2599.           ActualColors[i].green:=Pal256[i][1] SHR 2;
  2600.           ActualColors[i].blue :=Pal256[i][2] SHR 2;
  2601.          END;
  2602.         SetPalette(ActualColors);
  2603.        END
  2604.   ELSE IF AnzColors<=16
  2605.         THEN FOR i:=0 TO AnzColors-1 DO
  2606.               SetRGBPalette(i,Header.Palette[i][0] SHR 2,
  2607.                               Header.Palette[i][1] SHR 2,
  2608.                               Header.Palette[i][2] SHR 2);
  2609.  
  2610.  GetBigPalette(ActualColors);
  2611.  
  2612.  MaxZeile:=Header.ymax-Header.ymin;
  2613.  IF MaxZeile>GetMaxY
  2614.   THEN MaxZeile:=GetMaxY;
  2615.  DisplayPCXdata(Header,MaxZeile,fin);
  2616.  
  2617.  DrawMaus; {...und anzeigen}
  2618.  EnableMouse;
  2619.  
  2620.  repeat
  2621.   IF KeyPressed
  2622.    THEN BEGIN
  2623.          ch:=ReadKey; Shift:=(mem[$0:$417] AND 3)<>0;
  2624.          IF ch=#0
  2625.           THEN Wahl:=ORD(ReadKey) SHL 8  {Funktionstasten -> >256}
  2626.           ELSE Wahl:=ORD(ch);
  2627.          CASE Wahl OF
  2628.           $3B00: Event:=EventHelp;                {F1   = Hilfe}
  2629.           13:    Event:=EventSpeichern;           {CR   = File speichern}
  2630.           $1B,$4400: Event:=EventQuit;            {ESC,F10 = Beenden}
  2631.           else Event:=EventError;
  2632.          END;
  2633.         END;
  2634.  
  2635.   IF Event=EventNone  {keine Taste gedrückt, aber vielleicht Mausaktion?}
  2636.    THEN IF MouseUpdate
  2637.           THEN BEGIN {Mausaktion}
  2638.                 {N.B.: soll ein Event jetzt noch nachträglich "gelöscht"  }
  2639.                 {werden, so muß es auf "EventMouseMoved" gesetzt werden,  }
  2640.                 {nicht aber auf "EventNone", denn es ist ja was mit der }
  2641.                 {Maus passiert, (sie wurde zumindest bewegt oder geclickt)}
  2642.                 {Würde man dies ignorieren, so würde die Maus nicht mehr  }
  2643.                 {"enabled" werden!}
  2644.                 Event:=MouseEvent(menu); 
  2645.                END;
  2646.  
  2647.   IF Event<>EventNone
  2648.    THEN UnDrawMaus; {alten Bildschirminhalt unter Mauscursor restaurieren}
  2649.  
  2650.   CASE Event OF
  2651.    EventHelp       : Help;
  2652.    EventSpeichern  : Speichern;
  2653.    EventNone:;
  2654.    EventError      : ErrBeep;
  2655.    EventMouseMoved : UpdateBox;
  2656.    EventQuit : BEGIN  {Bei "Quit" lieber nochmal rückfragen}
  2657.                 IF FirstOfTwoBoxes(MeldungX,MeldungY,
  2658.                                    MeldungX+220,MeldungY+60,
  2659.                                    'yes','no',
  2660.                                    '','Really quit?','',
  2661.                                    alternative)
  2662.                         THEN Event:=EventEndProgram
  2663.                         ELSE Event:=EventMouseMoved
  2664.                END
  2665.  
  2666.    else ErrBeep;
  2667.   END;
  2668.  
  2669.   IF Event<>EventNone
  2670.    THEN BEGIN  {Mauszeiger wurde gelöscht, jetzt wieder neuzeichnen}
  2671.          DrawMaus;
  2672.          ClearMouse; {Mausereignis abgearbeitet}
  2673.         END;
  2674.  
  2675.   IF Event<>EventEndProgram THEN Event:=EventNone;
  2676.  until Event=EventEndProgram; {Ende = F10 + Bestätigung}
  2677.  
  2678.  restorecrtmode;
  2679.  SwapVectors;
  2680.  
  2681.  regs.ax := 12;
  2682.  regs.cx := 0;
  2683.  intr($33,regs); {Mousecallback de-installieren}
  2684.  
  2685.  
  2686. END.
  2687.